I have recently replace queries and lines of code like the following
DoCmd.OutputTo acQuery, "L001", "MicrosoftExcel(*.xls)", "\\ntoscar\t-drive\Accounting\UPS\Store Billings\" & Format(Date, "YYYY") & "\" & Format(Date, "MMM") & "\" & Format(Date, "YYMM") & "UPS-L001.XLS", False, ""
with this
Dim db As DAO.Database
Dim rst1 As DAO.Recordset
Dim strQry As String
Dim qryDef As QueryDef
Dim FileName As String
Dim DestDir As String
Set db = CurrentDb
Set rst1 = db.OpenRecordset("SELECT * FROM tb1_UPS_ebill ORDER BY StoreNumber, StoreName;")
While (Not rst1.EOF)
strQry = "SELECT tb1_ups_ebill.StoreNumber, tb1_ups_ebill.StoreName," & _
" tb1_ups_ebill.InvoiceNumber, tb1_ups_ebill.BillDate, tb1_ups_ebill.InvoiceAmt," & _
" tb1_ups_ebill.TrackingNumber, tb1_ups_ebill.REF1 AS Department," & _
" tb1_ups_ebill.ReferenceNo1, tb1_ups_ebill.ReferenceNo2, tb1_ups_ebill.Internet_Id," & _
" tb1_ups_ebill.Quantity, tb1_ups_ebill.Billed_Weight, tb1_ups_ebill.Zone," & _
" tb1_ups_ebill.Transaction_Code, tb1_ups_ebill.Service_Description," & _
" tb1_ups_ebill.Bill_Option, tb1_ups_ebill.PickUp_Date, tb1_ups_ebill.Sender_Name," & _
" tb1_ups_ebill.Sender_Company_Name, tb1_ups_ebill.Sender_City, tb1_ups_ebill.Sender_State," & _
" tb1_ups_ebill.Receiver_Name, tb1_ups_ebill.Receiver_Company_Name," & _
" tb1_ups_ebill.Receiver_Street, tb1_ups_ebill.Receiver_City, tb1_ups_ebill.Receiver_State," & _
" tb1_ups_ebill.Receiver_ZipCode, tb1_ups_ebill.Receiver_Country," & _
" tb1_ups_ebill.Net_Charges, tb1_ups_ebill.Incentive FROM tb1_ups_ebill" & _
" WHERE [StoreName]='" & rst1.Fields(1) & "';"
Set qryDef = db.CreateQueryDef(rst1.Fields(1), strQry)
FileName = Format(Date, "YYMM") & "-" & rst1.Fields(0) & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, rst1.Fields(1), DestDir & FileName
db.QueryDefs.Delete (rst1.Fields(1))
rst1.MoveNext
Wend
Set rst1 = Nothing
Set db = Nothing
End Sub
The old way ran in less than a minute, the new way though more flexible takes more than 10 minutes. Is their a way to speed this up.
DoCmd.OutputTo acQuery, "L001", "MicrosoftExcel(*.xls)", "\\ntoscar\t-drive\Accounting\UPS\Store Billings\" & Format(Date, "YYYY") & "\" & Format(Date, "MMM") & "\" & Format(Date, "YYMM") & "UPS-L001.XLS", False, ""
with this
Dim db As DAO.Database
Dim rst1 As DAO.Recordset
Dim strQry As String
Dim qryDef As QueryDef
Dim FileName As String
Dim DestDir As String
Set db = CurrentDb
Set rst1 = db.OpenRecordset("SELECT * FROM tb1_UPS_ebill ORDER BY StoreNumber, StoreName;")
While (Not rst1.EOF)
strQry = "SELECT tb1_ups_ebill.StoreNumber, tb1_ups_ebill.StoreName," & _
" tb1_ups_ebill.InvoiceNumber, tb1_ups_ebill.BillDate, tb1_ups_ebill.InvoiceAmt," & _
" tb1_ups_ebill.TrackingNumber, tb1_ups_ebill.REF1 AS Department," & _
" tb1_ups_ebill.ReferenceNo1, tb1_ups_ebill.ReferenceNo2, tb1_ups_ebill.Internet_Id," & _
" tb1_ups_ebill.Quantity, tb1_ups_ebill.Billed_Weight, tb1_ups_ebill.Zone," & _
" tb1_ups_ebill.Transaction_Code, tb1_ups_ebill.Service_Description," & _
" tb1_ups_ebill.Bill_Option, tb1_ups_ebill.PickUp_Date, tb1_ups_ebill.Sender_Name," & _
" tb1_ups_ebill.Sender_Company_Name, tb1_ups_ebill.Sender_City, tb1_ups_ebill.Sender_State," & _
" tb1_ups_ebill.Receiver_Name, tb1_ups_ebill.Receiver_Company_Name," & _
" tb1_ups_ebill.Receiver_Street, tb1_ups_ebill.Receiver_City, tb1_ups_ebill.Receiver_State," & _
" tb1_ups_ebill.Receiver_ZipCode, tb1_ups_ebill.Receiver_Country," & _
" tb1_ups_ebill.Net_Charges, tb1_ups_ebill.Incentive FROM tb1_ups_ebill" & _
" WHERE [StoreName]='" & rst1.Fields(1) & "';"
Set qryDef = db.CreateQueryDef(rst1.Fields(1), strQry)
FileName = Format(Date, "YYMM") & "-" & rst1.Fields(0) & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, rst1.Fields(1), DestDir & FileName
db.QueryDefs.Delete (rst1.Fields(1))
rst1.MoveNext
Wend
Set rst1 = Nothing
Set db = Nothing
End Sub
The old way ran in less than a minute, the new way though more flexible takes more than 10 minutes. Is their a way to speed this up.