MS Access Export To MS Excel Script

[santa12345]

Hello.
Currently I have a process in place where in Access, I have a customer database. The customer database is a single locally stored database on my computer with no links to any other external databases on a server, all information resides within this one database. Within the customer database, I then use a form I created. The form simply has a button to run some vb script. The script then runs a series of queries pulling data from various other tables (customer address, customer purchases, etc... using [Forms]![Form1]![customer_id] and after each table query, exports to an excel customer id template file and renames the excel template file to the actual customer id.xls, etc.. and loops until I get thru the entire customer id table list. Usually around 2500-3000 customers.

Initially, it currently takes approx 1 minute per file to generate. Very Acceptable!!

Unfortunately, after around 500'ish files are generated, the process tends to start lagging. Taking 2,3,4 sometimes 5 minutes a file to generate. Before I just replace the workstation with a possibly faster processor, and try that, I am wondering if the current commands I am using are still "up to date" or if there is a better / more efficient way to do this.

I am basically using DoCmd.OpenQuery and DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8 commands to accomplish this.

I do have sleep commands between each OpenQuery command. So after running the Customer Address query, capturing that data and exporting to the template, Sleep (2000), and then start running the Customer Purchases query for example. I believe I added this due to getting a customer id template.xls file already in use type message in the past.

The code was written using the following:

Microsoft Access Database (.accdb) Access 2016 File Format and Excel 97-2003 Worksheet

Any suggestions / ideas would be greatly appreciated. Thank you.

 

[welshgasman]

So how are you actually passing the customerID to the queries?
I cannot see anything in what you have previously posted.?

I would likely use a TempVar() in the query, which you would set before the Transfers.

 

[santa12345]

Someone on another site has suggested ADODB?
Here is their example. 29 tables took under a second. You of course need your queries.

Private Sub ExportTablesToExcelByADODB()

    Dim ExcelFile As String
 
    Dim ConnectionString As String
    Dim cnn As ADODB.Connection
    Dim InsertIntoSql As String
 
    ExcelFile = CurrentProject.Path & "\TestFile" & Format(Now(), "_yymmddhhnnss") & ".xlsx"
    ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ExcelFile & ";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

    Set cnn = New ADODB.Connection
    cnn.Open ConnectionString
 
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
 
    Set db = CurrentDb
    For Each tdf In db.TableDefs
        If (tdf.Attributes And dbSystemObject) = 0 Then
            InsertIntoSql = "Select * INTO [" & tdf.Name & "] FROM [MS Access;DATABASE=" & CurrentProject.FullName & "].[" & tdf.Name & "]"
            cnn.Execute InsertIntoSql
        End If
    Next

    cnn.Close

End Sub
[/thn
[QUOTE="welshgasman, post: 6253572, member: 246270"]
Someone on another site has suggested ADODB?
Here is their example. 29 tables took under a second. You of course need your queries.

[CODE=vba]Private Sub ExportTablesToExcelByADODB()

    Dim ExcelFile As String
 
    Dim ConnectionString As String
    Dim cnn As ADODB.Connection
    Dim InsertIntoSql As String
 
    ExcelFile = CurrentProject.Path & "\TestFile" & Format(Now(), "_yymmddhhnnss") & ".xlsx"
    ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ExcelFile & ";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

    Set cnn = New ADODB.Connection
    cnn.Open ConnectionString
 
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
 
    Set db = CurrentDb
    For Each tdf In db.TableDefs
        If (tdf.Attributes And dbSystemObject) = 0 Then
            InsertIntoSql = "Select * INTO [" & tdf.Name & "] FROM [MS Access;DATABASE=" & CurrentProject.FullName & "].[" & tdf.Name & "]"
            cnn.Execute InsertIntoSql
        End If
    Next

    cnn.Close

End Sub

Thank you. Does this code live inside excel or access. i am horrible at VB. I will try and take this code and I assume I still need to use some of my code... for the open query part as well as the file name piece.
[/QUOTE]

 

[welshgasman]

It is Acces code. However I would try what you have now. Just do not open the queries, but make sure tha criteria for each is set.
The transfer will open the queries to enable the transfer, so you have most of it working now as it is.

If your VBA is not that great, then that other method might not be for you.? They were just suggesting a potentially quicker method.
As you are now I believe you are opening the queries twice, and you never close them?

Humour me and go with just the transfers only as a test.

 

[santa12345]

It is Acces code. However I would try what you have now. Just do not open the queries, but make sure tha criteria for each is set.
The transfer will open the queries to enable the transfer, so you have most of it working now as it is.

If your VBA is not that great, then that other method might not be for you.? They were just suggesting a potentially quicker method.
As you are now I believe you are opening the queries twice, and you never close them?

Humour me and go with just the transfers only as a test.

Hi.. if i comment out the open queries. The files start to generate and are properly named for each customer ID, but each file contains the same information within each file, since each query wasn't refreshed and the process just grabs what was last in the table output for those 10 queries.

 

[welshgasman]

So those queries are maketable queries? Why? Why are they just not simple Select queries?
The queries should have criteria for each customer and perhaps a date range? I would use tempvars for that.
So within a recordset of customers, I would set the tempvar with the cust id, have already set the date range and then issue the Transfer.

In the Transfer, those names are of tables and not queries? I thought they were the query names?

 

[santa12345]

So those queries are maketable queries? Why? Why are they just not simple Select queries?
The queries should have criteria for each customer and perhaps a date range? I would use tempvars for that.
So within a recordset of customers, I would set the tempvar with the cust id, have already set the date range and then issue the Transfer.

In the Transfer, those names are of tables and not queries? I thought they were the query names?

Yes, the queries are make table queries. And yes, the customer ID is passed thru each query using a recordset. cust_id = rs![Customer_Id]
All the date piece is doing, is I type in a month in the dialog box on the Form. Form1. and it creates a folder and starts placing the newly generated customer id files in that folder and sub folders.
So tempvar replaces... this piece or ?

Dim rs As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set rs = db.OpenRecordset("Master Customer ID File", dbOpenTable)

rs.MoveFirst

Do Until rs.EOF

cust_id = rs![customer_id]

Yes. In the transfer, the name of the tables (output from the make table queries) are then referenced to export to excel.

 

[welshgasman]

OK. Would have been worth knowing that at the start.
Why maketable queries and not simple Select queries?

 

[welshgasman]

Here is something I just spotted that I have. I use this to create a spreadsheet for my diabetes database.

Function SendToExcel(strTQName As String, strSheetName As String, strPath As String, strSheet As String)

' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
' strPath is full path and name of Excel workbook

    'Dim ApXL As Object, xlWBk As Object, xlWSh As Object
    Dim ApXL As Excel.Application
    Dim xlWBk As Excel.Workbook
    Dim xlWsh As Excel.Worksheet
    Dim rs As DAO.Recordset

    On Error GoTo Err_Handler
'    Debug.Print "strTQname: " & strTQName
'    Debug.Print "strSheetName: " & strSheetName
'    Debug.Print "strPath: " & strPath

    Set rs = CurrentDb.OpenRecordset(strTQName)
    If rs.EOF Then
        MsgBox "No records to export"
        Exit Function
    End If
    Set ApXL = Excel.Application


    Set xlWBk = ApXL.Workbooks.Open(strPath)

 

    'Exit Function

    Set xlWsh = xlWBk.Worksheets(strSheetName)

    rs.MoveFirst

    xlWsh.Range("A2").CopyFromRecordset rs

    'Selects the first cell to unselect all cells

    'xlWsh.Range("A2").Select
    xlWBk.Worksheets(strSheet).Select
    ApXL.Visible = True
    'xlWsh.Activate

'    xlWsh.Cells.Rows(4).AutoFilter
'
'    xlWsh.Cells.Rows(4).EntireColumn.AutoFit



    rs.Close

    Set rs = Nothing

    'Remove prompts to save the report

    ApXL.DisplayAlerts = False

    xlWBk.Save    'As "Put the path where you want the file saved OR change to just save your existing file", 51

    ApXL.DisplayAlerts = True
  
    Exit Function

Err_Handler:

    DoCmd.SetWarnings True

    MsgBox Err.Description, vbExclamation, Err.Number

    Exit Function

End Function

and called by

Private Sub CmdChart_Click()
' Export query to Excel for easier chart display

Call SendToExcel("qryMonthlyCalc", "qryMonthlyCalc", "F:\Users\Paul\Documents\Diabetes.xlsx", "Chart")

End Sub

You will need to tailor it a little if you use it. However I cannot see why you cannot use simple Select queries to start with?

 

[santa12345]

Here is something I just spotted that I have. I use this to create a spreadsheet for my diabetes database.

Function SendToExcel(strTQName As String, strSheetName As String, strPath As String, strSheet As String)

' strTQName is the name of the table or query you want to send to Excel
' strSheetName is the name of the sheet you want to send it to
' strPath is full path and name of Excel workbook

    'Dim ApXL As Object, xlWBk As Object, xlWSh As Object
    Dim ApXL As Excel.Application
    Dim xlWBk As Excel.Workbook
    Dim xlWsh As Excel.Worksheet
    Dim rs As DAO.Recordset

    On Error GoTo Err_Handler
'    Debug.Print "strTQname: " & strTQName
'    Debug.Print "strSheetName: " & strSheetName
'    Debug.Print "strPath: " & strPath

    Set rs = CurrentDb.OpenRecordset(strTQName)
    If rs.EOF Then
        MsgBox "No records to export"
        Exit Function
    End If
    Set ApXL = Excel.Application


    Set xlWBk = ApXL.Workbooks.Open(strPath)

 

    'Exit Function

    Set xlWsh = xlWBk.Worksheets(strSheetName)

    rs.MoveFirst

    xlWsh.Range("A2").CopyFromRecordset rs

    'Selects the first cell to unselect all cells

    'xlWsh.Range("A2").Select
    xlWBk.Worksheets(strSheet).Select
    ApXL.Visible = True
    'xlWsh.Activate

'    xlWsh.Cells.Rows(4).AutoFilter
'
'    xlWsh.Cells.Rows(4).EntireColumn.AutoFit



    rs.Close

    Set rs = Nothing

    'Remove prompts to save the report

    ApXL.DisplayAlerts = False

    xlWBk.Save    'As "Put the path where you want the file saved OR change to just save your existing file", 51

    ApXL.DisplayAlerts = True
 
    Exit Function

Err_Handler:

    DoCmd.SetWarnings True

    MsgBox Err.Description, vbExclamation, Err.Number

    Exit Function

End Function

and called by

Private Sub CmdChart_Click()
' Export query to Excel for easier chart display

Call SendToExcel("qryMonthlyCalc", "qryMonthlyCalc", "F:\Users\Paul\Documents\Diabetes.xlsx", "Chart")

End Sub

You will need to tailor it a little if you use it. However I cannot see why you cannot use simple Select queries to start with?

ok thank you again. i will give it a whirl.... might take me some time.. .i'm pretty slow at this stuff

 

[welshgasman]

I would still be going with a simple select query for all those queries. Then just use the simple TransferSpreadsheet as I have already said a good few times?