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
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