VBA copyfromrecordset into excel failing in created workbook

[Margarita]

Hello, I am working in access 2003. I need some quidance on a vba module I wrote for the on-click event of a user form. In this form, the user sets several parameters for a query which will be used in the vba code. The on-click sub is supposed to do the following:
-Create a different workbook for each Task in the Tasks recordset
-In each book, create a sheet for each subtask in the Subtasks recordset
-Format the sheet in a particular way and
-Copy the values of the main MonthlySalariesTOTALS query recordset into each worksheet
-This is accomplished in two nested loops: tasks loop and subtasks loop.

Now, I have the code creating all the books, all the sheets, and doing the formatting perfectly. However, nothing gets pasted. As a debugging measure, I put debug.print "values pasted" into the code and that appears in the immediate window, so I assume something should get pasted. But nothing does get pasted!

When I run the MonthlySalariesTOTALS query manually, not through vba, it gives me the right results- so no problems there. I am going crazy over this, trying to figure out why it's not pasting!

Additional note: this may or may not be important, but when I go into the sub-folder where the workbooks are supposed to get saved, I don't see anything unless I break out of the code. When I break, I see the workbooks in the subfolder, but nothing pasted in any single one of them. I have tried waiting for a very long time for this code to finish running and for the workbooks to appear where they're supposed to be without me breaking out of the module. But no success- I have had to break out every time. Does this have to do with the failed pasting attempts?

My code is below. If anyone could take a look and provide any suggestion on where the values that are supposed to get pasted are getting lost, I would greatly appreciate it. Thank you in advance!

Private Sub Detail_Click()
 
Dim dbs    As DAO.Database
Set dbs = CurrentDb
Set xlApp = CreateObject("Excel.Application")
'xlApp.Visible = True
 
'Set up Tasks Loop
Dim qdf_Tasks As QueryDef
Set qdf_Tasks = CurrentDb.QueryDefs!DistinctServiceCats
Dim rs_Tasks As DAO.Recordset
Set rs_Tasks = qdf_Tasks.OpenRecordset
 
rs_Tasks.MoveFirst
 
Do While Not rs_Tasks.EOF     '-------loop through Tasks to create workbooks
Dim currenttask As String
currenttask = rs_Tasks.Fields(0).Value
Dim wb As Object
xlApp.SheetsInNewWorkbook = 1
Set wb = xlApp.Workbooks.ADD
 
 
Dim SQL_subtasks
SQL_subtasks = "Select ServiceSubcat from SERVICES where ServiceCat like " & Chr(34) & currenttask & Chr(34) & ";"
Dim rs_subtasks As DAO.Recordset
Set rs_subtasks = CurrentDb.OpenRecordset(SQL_subtasks, dbOpenSnapshot)
rs_subtasks.MoveFirst
 
Do While Not rs_subtasks.EOF     '--------Loop through subtasks to create worksheets
 
Dim currentsubtask As String
currentsubtask = rs_subtasks.Fields(0).Value
 
wb.worksheets.ADD
 
Dim SQLsheetname As String
SQLsheetname = "Select TemplateName from SERVICES where ServiceSubcat like " & Chr(34) & currentsubtask & Chr(34) & ";"
 
Dim rs_sheetname As DAO.Recordset
Set rs_sheetname = CurrentDb.OpenRecordset(SQLsheetname, dbOpenSnapshot)
Dim currentsubtasktemplate As String
currentsubtasktemplate = rs_sheetname.Fields(0).Value
 
wb.activesheet.Name = currentsubtasktemplate
 
'Format header and PS first section:
 
With wb.sheets(currentsubtasktemplate)
   .range("A4").Value = "Direct Labor"
    .range("A5").Value = "0-35 hours"
    .range("A6").Value = "Name"
    .range("B6").Value = "Role"
    .range("C6").Value = "Month's Salary"
    .range("D6").Value = "%"
    .range("E5").Value = "Month's Charge"
    .range("F6").Value = "Fringe"
    .range("G6").Value = "TOTALS"
   End With
 
'Run MonthlyTOTALS
 
Dim qdf_monthsal As DAO.QueryDef
Set qdf_monthsal = CurrentDb.QueryDefs!MonthlySalary_FinalQuery_TASK_TOTALS
 
'parameters:
qdf_monthsal.Parameters![start date] = Forms!MonthlyReportForm.Reportstartdate
qdf_monthsal.Parameters![end date] = Forms!MonthlyReportForm.Reportstartdate
qdf_monthsal.Parameters![select FTE month] = Forms!MonthlyReportForm.MonthFTE
qdf_monthsal.Parameters![subcat] = currentsubtask
qdf_monthsal.Parameters![ott] = "REG"
 
Dim rs_monthsal As DAO.Recordset
Set rs_monthsal = qdf_monthsal.OpenRecordset
 
wb.activesheet.range("A7").CopyFromRecordset rs_monthsal
Debug.Print "pasted values"
 
rs_subtasks.MoveNext
Loop     '---------end of subtasks/worksheets loop
 
 
On Error GoTo ExitSub
xlApp.DisplayAlerts = False
wb.saveas filename:="H:\BUDGET Reporting\Reports\" & currenttask & "Report.xls"
xlApp.DisplayAlerts = True
wb.Close
rs_Tasks.MoveNext
Loop         '-------end of Tasks/workbooks loop
ExitSub:
'wb.Close
Debug.Print "Workbook exists, need to delete"
End Sub

 

[Margarita]

Hello, here is an update of what I tried:
I included a message in the status bar 'please wait while generating report' in hopes that it will show me when the sub is actually done running. Well, here is what happens: the sub creates all the workbooks with all the right sheets and the correct formatting. However, nothing is pasted (and the recordset should get pasted before the next sheet is created). In the meantime, I have tried waiting for a long time and still the status message doesn't go away, and nothing is pasted. I break out of the sub and am then able to close the workbooks. So it seems that the sub is bypassing the pasting step (though the debugger does print 'values pasted') and gets stuck on something that doesn't let it close the workbooks for a very long time. Please help! Where can it be getting stuck if the debugger prints what it is supposed to print?
Thank you!