Code: Select all
Dim rs As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Open(CurrentDBDir & "OutputTemplate.xlsx")
ApXL.Visible = True
ApXL.ScreenUpdating = True
'Top
Set rs = CurrentDb.OpenRecordset("qrySlide3TopChart")
Set xlWSh = xlWBk.Worksheets("Data")
xlWSh.Activate
xlWSh.Range("A3").Select
xlWSh.Range("A3").CopyFromRecordset rs
rs.Close
'Bottom
Set rs = CurrentDb.OpenRecordset("qrySlide3BottomChart")
xlWSh.Activate
xlWSh.Range("A17").Select
xlWSh.Range("A17").CopyFromRecordset rs
rs.Close
'Full Details
Set rs = CurrentDb.OpenRecordset("qryFinalDetails")
'Set xlWSh = xlWBk.Worksheets("Data")
xlWSh.Activate
xlWSh.Range("P3").Select
xlWSh.Range("P3").CopyFromRecordset rs
rs.Close
xlWBk.Worksheets("FinalDetails").Activate
xlWBk.Worksheets("FinalDetails").Columns("E:E").Select
xlWBk.Worksheets("FinalDetails").Columns("E:E").WrapText = True
xlWBk.Worksheets("FinalDetails").Range("A1").Select
xlWBk.Worksheets("Slide3Top").Activate
'Save it
ApXL.activeworkbook.SavecopyAs FileName:=CurrentDBDir & "Output\Legal Audit_" & Format(Now, "yyyymmdd_hhnnss") & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Pointers?