Export datasets to different Excel spreadsheets in the same workbo

A

Akilah

Hi, I have this code that exports different sets of data to different sheets
in an Excel Workbook. The problem is it exports the first sheet correctly but
some time during the export of the following data, some of the first sheet's
data gets changed. Can you please help find what step I may be missing.
Thanks


Function ExportToExcel(strCell As String)
Dim QueryName As QueryDef
Dim rsQuery As DAO.Recordset
Dim strDate As String
On Error GoTo cErr


Set rs1 = CurrentDb.OpenRecordset("SELECT * FROM tbl_Report_Paths where
Report = 'Monthly Management'")

strDate = Format(Date, "mm") & "_" & Format(Date, "dd") & "_" &
Format(Date, "yyyy") '& "_" & Format(Time, "hhmmss")

Set rs2 = CurrentDb.OpenRecordset("SELECT All_MF, Actual_MF,All_PIH,
Actual_PIH FROM tbl10_NewSummary")

'open Excel Instances
Set oExcel = CreateObject("Excel.Application")
'Open current report spreadsheet
Set oBook = oExcel.Workbooks.Open(rs1.Fields(1))
'open designated worksheet
Set oSheet = oBook.Worksheets("Summary Report")
oSheet.range(strCell).CopyFromRecordset rs2
oSheet.Save

Set rs2 = CurrentDb.OpenRecordset("SELECT * FROM qry4_ALL_MF")
Set oSheet = oBook.Worksheets("qry4_All_MF")
oSheet.range("A2").CopyFromRecordset rs2
Set rs2 = Nothing

Set rs2 = CurrentDb.OpenRecordset("SELECT * FROM qry2_Actual_MF")
Set oSheet = oBook.Worksheets("qry2_Actual_MF")
oSheet.range("A2").CopyFromRecordset rs2
Set rs2 = Nothing

Set rs2 = CurrentDb.OpenRecordset("SELECT * FROM qry5_ALL_PIH")
Set oSheet = oBook.Worksheets("qry5_ALL_PIH")
oSheet.range("A2").CopyFromRecordset rs2
Set rs2 = Nothing

Set rs2 = CurrentDb.OpenRecordset("SELECT * FROM qry3_Actual_PIH")
Set oSheet = oBook.Worksheets("qry3_Actual_PIH")
oSheet.range("A2").CopyFromRecordset rs2
rs2.Close
Set rs2 = Nothing

'save the workbook
oBook.SaveAs (rs1.Fields(2) & strDate & ".xlsx")

'quit Excel
oExcel.Quit



MsgBox "The MMR report has been saved to " & rs1.Fields(2) & strDate &
".xlsx", vbInformation

rs1.Close
Set rs1 = Nothing


cErr:

If Err.Number <> 0 And Err.Number <> 0 Then

oBook.Close SaveChanges:=False
MsgBox "Report Generation Cancelled ", vbInformation

End If

End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top