Export multiple queries to multiple excel sheets.
That is my code. Sorry it is so long, but it is the same code four times on four different command buttons for four different queries that I am exporting from access to excel.
Once I export the first query, my code opens up the correct excel workbook and places it on the correct spreadsheet (Sheet1). This workbook stays open, so when I export the second query it opens up a [Read-Only] version of the correct workbook and places it on the correct sheet (Sheet2), but it is on a copy of the correct workboook.
So now I have two of the same workbooks open with one export in each. I export the third query and a third read-only workbook opens. I export a fourth query and a fourth read-only workbook opens. Even though the exports are on the correct sheets in the copies of the workbooks, they are all in separate workbooks.
If after each individual export, I save and the close the excel workbook before the next export, everything works as planned, but I would rather not do that considering I have several more queries that I will be creating and exporting.
How do I fix my code so after the first export, I can keep the excel workbook open and keep exporting each query into the appropriate sheet?
I am very sorry this is so long, but I wanted to try and explain this the best way I could.
Thank you for any help that you can provide!
Code:
Option Compare Database
Private Sub Command11_Click()
' ______________________________________________________________________
' EXPORTS "BLOCK COUNT (FILTERED)" QUERY TO EXCEL SHEET1
Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Dim strPath As String
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
On Error GoTo err_handler
strPath = strFilePath
Set rst = CurrentDb.OpenRecordset("Block Count (Filtered)")
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Open("C:\FileName")
ApXL.Visible = True
Set xlWSh = xlWBk.Worksheets("Sheet1")
xlWSh.Activate
xlWSh.Range("A1").Select
For Each fld In rst.Fields
ApXL.ActiveCell = fld.Name
ApXL.ActiveCell.Offset(0, 1).Select
Next
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:30").Select
' This is included to show some of what you can do about formatting. You can comment out or delete
' any of this that you don't want to use in your own export.
With ApXL.Selection.Font
.Name = "Calibri"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
ApXL.Selection.Font.Bold = False
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select
rst.Close
Set rst = Nothing
Exit_SendTQ2XLWbSheet:
Exit Sub
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_SendTQ2XLWbSheet
Exit Sub
End Sub
Private Sub Command12_Click()
' ____________________________________________________________________
' EXPORTS "PROPOSAL COUNT (FILTERED)" TO EXCEL SHEET2
Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Dim strPath As String
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
On Error GoTo err_handler
strPath = strFilePath
Set rst = CurrentDb.OpenRecordset("Proposal Count (Filtered)")
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Open("C:\FileName")
ApXL.Visible = True
Set xlWSh = xlWBk.Worksheets("Sheet2")
xlWSh.Activate
xlWSh.Range("A1").Select
For Each fld In rst.Fields
ApXL.ActiveCell = fld.Name
ApXL.ActiveCell.Offset(0, 1).Select
Next
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:30").Select
' This is included to show some of what you can do about formatting. You can comment out or delete
' any of this that you don't want to use in your own export.
With ApXL.Selection.Font
.Name = "Calibri"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
ApXL.Selection.Font.Bold = False
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select
rst.Close
Set rst = Nothing
Exit_SendTQ2XLWbSheet:
Exit Sub
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_SendTQ2XLWbSheet
Exit Sub
End Sub
Private Sub Command13_Click()
' __________________________________________________________________________
' EXPORTS "BLOCK SENDBACKS (FILTERED)" TO EXCEL SHEET3
Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Dim strPath As String
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
On Error GoTo err_handler
strPath = strFilePath
Set rst = CurrentDb.OpenRecordset("Block Sendbacks (Filtered)")
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Open("C:\FileName")
ApXL.Visible = True
Set xlWSh = xlWBk.Worksheets("Sheet3")
xlWSh.Activate
xlWSh.Range("A1").Select
For Each fld In rst.Fields
ApXL.ActiveCell = fld.Name
ApXL.ActiveCell.Offset(0, 1).Select
Next
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:30").Select
' This is included to show some of what you can do about formatting. You can comment out or delete
' any of this that you don't want to use in your own export.
With ApXL.Selection.Font
.Name = "Calibri"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
ApXL.Selection.Font.Bold = False
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select
rst.Close
Set rst = Nothing
Exit_SendTQ2XLWbSheet:
Exit Sub
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_SendTQ2XLWbSheet
Exit Sub
End Sub
Private Sub Command14_Click()
' ______________________________________________________________________
' EXPORTS "PROPOSAL SENDBACKS (FILTERED)" TO EXCEL SHEET4
Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As DAO.Field
Dim strPath As String
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
On Error GoTo err_handler
strPath = strFilePath
Set rst = CurrentDb.OpenRecordset("Proposal Sendbacks (Filtered)")
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Open("C:\FileName")
ApXL.Visible = True
Set xlWSh = xlWBk.Worksheets("Sheet4")
xlWSh.Activate
xlWSh.Range("A1").Select
For Each fld In rst.Fields
ApXL.ActiveCell = fld.Name
ApXL.ActiveCell.Offset(0, 1).Select
Next
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:30").Select
' This is included to show some of what you can do about formatting. You can comment out or delete
' any of this that you don't want to use in your own export.
With ApXL.Selection.Font
.Name = "Calibri"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
ApXL.Selection.Font.Bold = False
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select
rst.Close
Set rst = Nothing
Exit_SendTQ2XLWbSheet:
Exit Sub
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_SendTQ2XLWbSheet
Exit Sub
End Sub
That is my code. Sorry it is so long, but it is the same code four times on four different command buttons for four different queries that I am exporting from access to excel.
Once I export the first query, my code opens up the correct excel workbook and places it on the correct spreadsheet (Sheet1). This workbook stays open, so when I export the second query it opens up a [Read-Only] version of the correct workbook and places it on the correct sheet (Sheet2), but it is on a copy of the correct workboook.
So now I have two of the same workbooks open with one export in each. I export the third query and a third read-only workbook opens. I export a fourth query and a fourth read-only workbook opens. Even though the exports are on the correct sheets in the copies of the workbooks, they are all in separate workbooks.
If after each individual export, I save and the close the excel workbook before the next export, everything works as planned, but I would rather not do that considering I have several more queries that I will be creating and exporting.
How do I fix my code so after the first export, I can keep the excel workbook open and keep exporting each query into the appropriate sheet?
I am very sorry this is so long, but I wanted to try and explain this the best way I could.
Thank you for any help that you can provide!
Last edited: