Solved Export Multiple Record sets to Multiple Excel Sheets (1 Viewer)

[jeran042]

Here is what I want to accomplish:
Output 2 different record sets to corresponding worksheets in an already created excel workbook.
Here is the code that I have so far. It does not throw any errors, and when I look at the excel file it appears to have been modified as the "Date Modified" updates.
Also I am sure that there are records in the record sets. I have test the SELECT statements.
I have blocked off where I need guidance:

Private Sub Command47_Click()

'BOF checks if current record position is before the first record
'EOF checks if current record position is after the last record
'If BOF and EOF both return TRUE, then the Table has no record
'rs.MoveFirst ‘makes the first record the current record, in case current record is not the first record

'Error handling
    'On Error GoTo Error_Handler
    

Dim sCost As String
Dim rsQuery As DAO.Recordset
Dim rsQuery_1 As DAO.Recordset
Dim rs As DAO.Recordset
Dim dbs As DAO.Database
Dim excelApp As Object
Dim sFilePath As String
Dim sDepartment As String
Dim oSheet As Object
Dim oBook As Object

'Dim sCost_Center As String
'Dim sSeparator As String
'Dim sExtension As String
'Dim sControllable_Tab As String
'Dim sExhibit_2_Tab As String

'This RS is departments who are a stakeholder in an Exhibit 2 line
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("SELECT DISTINCT TBL_CHART.EXHIBIT_2_COST FROM TBL_CHART WHERE TBL_CHART.EXHIBIT_2_COST Is Not Null")


'Set Variables
sFilePath = "Y:\Budget process information\BUDGET DEPARTMENTS\"
sSubFolder = "\MONTHLY EXPENSE REPORTS\"
'sControllable_Tab = "DETAIL_EXPENSE"
'sExhibit_2_Tab = "EXHIBIT_2_DETAIL"
'sSeparator = "\"
'sExtension = ".xlsm"


'Check to see if the recordset actually contains rows
'Do until there are no more records in the RS
If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst
    Do Until rs.EOF = True


sDepartment = DLookup("DEPARTMENT", "qryDepartment", "COST_CENTER =" & rs.Fields("EXHIBIT_2_COST"))
sCost_Center = rs.Fields("EXHIBIT_2_COST")


               
'Specify the query to be exported
    Set rsQuery = dbs.OpenRecordset("SELECT * FROM qryLedger_Detail_2019 WHERE COST_CENTER = " & sCost_Center)
    Set rsQuery_1 = dbs.OpenRecordset("SELECT * FROM qryLedger_Detail_2019_Exhibit WHERE EXHIBIT_2_COST = " & sCost_Center)

'Open an instance of Excel
    On Error Resume Next
        Set excelApp = GetObject(, "Excel.Applicationn")

    If Err.Number <> 0 Then
        Set excelApp = CreateObject("Excel.Application")
    End If
    Debug.Print "Excel Instance Created"
    

'Change True to False if you do not want the workbook to be
'Visible when the code is running
    excelApp.Visible = False

'Open the target workbook
    Set targetWorkbook = excelApp.Workbooks.Open(sFilePath & sDepartment & sSubFolder & sDepartment & "_YTD_DETAIL" & ".xlsm")
    Debug.Print "Excel File " & sDepartment & " Opened"
    
    
'##############################################################################################################
'This is the part I need help with


    For Each oSheet In oBook.Worksheets
       With oSheet
            If oSheet.Name = "DETAIL_EXPENSE" Then
                oSheet.Range("A2").CopyFromRecordset rsQuery
            ElseIf oSheet.Name = "EXHIBIT_2_DETAIL" Then
                oSheet.Range("A2").CopyFromRecordset rsQuery_1
            End If 'There will be other sheets in workbook, but the 2 above are the only ones i need to interact with.
       End With
    Next oSheet
    
    
 '##############################################################################################################
 
 
    
'Copy data to the specified sheet and range
'First attempt at populating workbooks
'    targetWorkbook.Worksheets("DETAIL_EXPENSE").Range("A2").CopyFromRecordset rsQuery
'    Debug.Print "Detail Expense Copied Into the " & sDepartment & " Workbook"
'
'    targetWorkbook.Worksheets("EXHIBIT_2_DETAIL").Range("A2").CopyFromRecordset rsQuery_1
'    Debug.Print "Exhibit 2 Detail Copied Into the " & sDepartment & " Workbook"

'Debug.Print rs.Fields("EXHIBIT_2_COST") & " - " & sDepartment
'Debug.Print sCost_Center & sFilePath & sDepartment & sSubFolder
'Debug.Print sFilePath & sDepartment & sSubFolder & sDepartment & "_YTD_DETAIL" & ".xlsm"


'Close the EXCEL file while saving the file, and clean up the EXCEL objects
    Set excelApp = Nothing
    
    targetWorkbook.Close True
    Debug.Print sDepartment & " Excel Workbook has been saved and Closed"
    
    Set targetWorkbook = Nothing
    rs.MoveNext
    'Debug.Print that we are moving to the next record with 2 line breaks in between
    Debug.Print "Moving to the next Recordset" & vbNewLine & StringTwo & vbNewLine & StringTwo
    
    Loop


Else
    MsgBox "There are no records in the recordset."
End If

MsgBox "Finished looping through records."

'Close the recordset & clean up
rs.Close
Set rs = Nothing



'Error_Handler_Exit:
'
''Close the EXCEL file while saving the file, and clean up the EXCEL objects
'    Set excelApp = Nothing
'    targetWorkbook.Close True
'    Set targetWorkbook = Nothing
'    rs.MoveNext
'
'    Exit Sub
'
'Error_Handler:
'    Select Case Err.Number
'        Case 2302
'            MsgBox "There is currently a file open with the name: " & vbCrLf & _
'                     sFilename & vbCrLf & _
'                    "Please close or rename open file! " _
'                    , vbOKOnly + vbExclamation, "DUPLICATE NAME WARNING"
'            Resume Error_Handler_Exit
'        Case Else
'            MsgBox "Error No. " & Err.Number & vbCrLf & "Description: " & Err.DESCRIPTION, vbExclamation, "Database Error"
'            Err.Clear
'            Resume Error_Handler_Exit
'    End Select


End Sub

 

[theDBguy]

Hi. Just curious, have you stepped through the code?

 

[jeran042]

Hi. Just curious, have you stepped through the code?

I am stepping through it now. It doesn't seem like oSheet is being set to anything.

 

[CJ_London]

compare this bit of code

'Open the target workbook
Set targetWorkbook = excelApp.Workbooks.Ope

with

For Each oSheet In oBook.Worksheets

 

[jeran042]

compare this bit of code

'Open the target workbook
Set targetWorkbook = excelApp.Workbooks.Ope

with

For Each oSheet In oBook.Worksheets

I did adjust that line to read:
For Each oSheet In oBook.targetWorkbook
But that still didn't correct my problem

 

[theDBguy]

I did adjust that line to read:
For Each oSheet In oBook.targetWorkbook
But that still didn't correct my problem

Hi. Do you have Option Explicit at the top of your module?

You could try:

For Each oSheet In targetWorkbook.Worksheets

Sent from phone...

 

[jeran042]

Hi. Do you have Option Explicit at the top of your module?

You could try:

For Each oSheet In targetWorkbook.Worksheets

Sent from phone...

This works so far:

    For Each oSheet In targetWorkbook.worksheets
       With oSheet
            MsgBox oSheet.Name
'            If oSheet.Name = "DETAIL_EXPENSE" Then
'                oSheet.Range("A2").CopyFromRecordset rsQuery
'            ElseIf oSheet.Name = "EXHIBIT_2_DETAIL" Then
'                oSheet.Range("A2").CopyFromRecordset rsQuery_1
'            End If 'There will be other sheets in workbook, but the 2 above are the only ones i need to interact with.
       End With
    Next oSheet

We may have come up with the answer at the same time (although I sure you knew from the get go )

 

[jeran042]

So the code actually works, but it is creating a copy of the workbook as opposed to using the one that is already created?
But if I save the copy and inspect it, it is what I intended. Any thoughts on that?

I found the issue, I has the:

 "rs.MoveNext"

inside the excel loop.

 

[theDBguy]

So, are you good to go now?

Sent from phone...