Access VBA Export To Multiple Excel Sheets Help

Question

I have a Access VBA code that export into a Excel workbook and it works fine but, I need it to be able to populate to 3 different sheets with 3 different query criteria, is this possible and if so, how can I add it to my code below: How do I add Sheet2 and Sheet3 to this code???

Sheet1 and Query "Test_Export_Trade1"

Sheet2 and Query "Test_Export_Trade2"

Sheet3 and Query "Test_Export_Trade3"

Private Sub Command90_Click()

Dim lngColumn As Long

Dim xlx As Object, xlw As Object, xls As Object, xlc As Object

Dim dbs As DAO.Database

Dim rst As DAO.Recordset

Dim blnEXCEL As Boolean, blnHeaderRow As Boolean

blnEXCEL = False

' Replace True with False if you do not want the first row of

' the worksheet to be a header row (the names of the fields

' from the recordset)

blnHeaderRow = True

' Establish an EXCEL application object

On Error Resume Next

Set xlx = GetObject(, "Excel.Application")

If Err.Number <> 0 Then

  Set xlx = CreateObject("Excel.Application") 

  blnEXCEL = True 

End If

Err.Clear

On Error GoTo 0

' Change True to False if you do not want the workbook to be

' visible when the code is running

xlx.Visible = False

' Replace C:\Filename.xls with the actual path and filename

' of the EXCEL file into which you will write the data

Set xlw = xlx.Workbooks.Open("C:\Users\MacFolder\Documents\ExportTrade.xlsx")

' Delete Cells in Sheet1

Worksheets("Sheet1").Cells.Delete

' Replace WorksheetName with the actual name of the worksheet

' in the EXCEL file

' (note that the worksheet must already be in the EXCEL file)

Set xls = xlw.Worksheets("Sheet1")

' Replace A1 with the cell reference into which the first data value

' is to be written

Set xlc = xls.Range("A1") ' this is the first cell into which data go

Set dbs = CurrentDb()

' Replace QueryOrTableName with the real name of the table or query

' whose data are to be written into the worksheet

Set rst = dbs.OpenRecordset("Test_Export_Trade1", dbOpenDynaset, dbReadOnly)

If rst.EOF = False And rst.BOF = False Then

  rst.MoveFirst 

  If blnHeaderRow = True Then 

        For lngColumn = 0 To rst.Fields.Count - 1 

              xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name 

        Next lngColumn 

        Set xlc = xlc.Offset(1, 0) 

  End If 

  ' write data to worksheet 

  Do While rst.EOF = False 

        For lngColumn = 0 To rst.Fields.Count - 1 

              xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value 

        Next lngColumn 

        rst.MoveNext 

        Set xlc = xlc.Offset(1, 0) 

  Loop 

End If

rst.Close

Set rst = Nothing

dbs.Close

Set dbs = Nothing

' Close the EXCEL file while saving the file, and clean up the EXCEL objects

Set xlc = Nothing

Set xls = Nothing

xlw.Close True ' close the EXCEL file and save the new data

Set xlw = Nothing

If blnEXCEL = True Then xlx.Quit

Set xlx = Nothing

End Sub

Answer 1

Thanks - my apologies. The line

'Set dbs = CurrentDb

shouldn't have been commented out. Please remove the apostrophe ' from the start of that line.

Answer 2

Runt-time error 91:

Object variable or With block variable not set

I found the issue in the sub ExportIT

' Set dbs = CurrentDb() was commented out so I uncommented the Set dbs = CurrentDb() for the Dim dbs As DAO.Database so it could Declare the variable and everything works great now...Thank you very much HansV...

Answer 3

What is the error message?

Answer 4

Hi HansV,

I received a error on line:

Set rst = dbs.OpenRecordset(QueryName, dbOpenDynaset, dbReadOnly)

Answer 5

Try this:

Private Sub Command90_Click()
Dim xlx As Object, xlw As Object
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean
blnEXCEL = False
' Replace True with False if you do not want the first row of
' the worksheet to be a header row (the names of the fields
' from the recordset)
blnHeaderRow = True
' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
On Error GoTo 0
' Change True to False if you do not want the workbook to be
' visible when the code is running
xlx.Visible = False
' Replace C:\Filename.xls with the actual path and filename
' of the EXCEL file into which you will write the data
Set xlw = xlx.Workbooks.Open("C:\Users\MacFolder\Documents\ExportTrade.xlsx")
ExportIt xlw, "Sheet1", "Test_Export_Trade1", blnHeaderRow
ExportIt xlw, "Sheet2", "Test_Export_Trade2", blnHeaderRow
ExportIt xlw, "Sheet1", "Test_Export_Trade1", blnHeaderRow
' Close the EXCEL file while saving the file, and clean up the EXCEL objects
xlw.Close SaveChanges:=True ' close the EXCEL file and save the new data
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing
End Sub

Sub ExportIt(xlw As Object, SheetName As String, QueryName As String, blnHeaderRow As Boolean)
Dim xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim lngColumn As Long
Set xls = xlw.Worksheets(SheetName)
' Delete Cells in Sheet1
xls.Cells.Clear
' Replace A1 with the cell reference into which the first data value
' is to be written
Set xlc = xls.Range("A1") ' this is the first cell into which data go
'Set dbs = CurrentDb
' Replace QueryOrTableName with the real name of the table or query
' whose data are to be written into the worksheet
Set rst = dbs.OpenRecordset(QueryName, dbOpenDynaset, dbReadOnly)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
If blnHeaderRow = True Then
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn
Set xlc = xlc.Offset(1, 0)
End If
' write data to worksheet
xlc.CopyFromRecordset rst
End If
Set xlc = Nothing
rst.Close
Set rst = Nothing
End Sub