CODEWITHSUNDEEP
excelvbams-access
essasix23
essasix23

Reputation: 19

MS Access Hangs on docmd.transferspreadsheet

I grabbed some export code from @LocEngineer (thank you!) from this thread here: Split MS Access table into parts and export into Excel using VBA But after implementation access will hang indefinitely when it hits the last line of the loop to export the next chunk. Does anyone have ideas why this would happen? Everything seems to be functioning correctly otherwise.. Any insight is very appreciated i am still learning my way around VBA. [MASTER] is the table to be broken in 25000 rows per excel export.[MaterialNumber] is not unique and contains duplicates in the table.

Sub ExportChunks()
Dim rs As Recordset
Dim ssql As String
Dim maxnum As Long
Dim numChunks As Integer

Dim qdef As QueryDef

ssql = "SELECT COUNT([Material Number]) FROM MASTER"
Set rs = CurrentDb.OpenRecordset(ssql)

maxnum = rs.Fields(0).Value  'total number of records

'add 0.5 so you always round up:
numChunks = Round((maxnum / 25000) + 0.5, 0)

On Error Resume Next 'don't break if Chunk_1 not yet in QueryDefs

ssql = "SELECT TOP 25000 * FROM MASTER"
CurrentDb.QueryDefs.Delete "Chunk"
Set qdef = New QueryDef
qdef.SQL = ssql
qdef.Name = "Chunk"
CurrentDb.QueryDefs.Append qdef
CurrentDb.QueryDefs.Refresh
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Chunk_1", "K:\Public\MDM\PMD\Chunk_1.xlsx"

For i = 2 To numChunks
    ssql = "SELECT TOP 25000 * FROM MASTER WHERE [Material Number] NOT IN (SELECT TOP " & (i - 1) * 25000 & " [Material Number] FROM MASTER)"
    Set qdef = CurrentDb.QueryDefs("Chunk")
    qdef.SQL = ssql
    CurrentDb.QueryDefs.Refresh
    Set qdef = CurrentDb.QueryDefs("Chunk_" & i)
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, qdef.Name, "K:\Public\MDM\PMD\" & qdef.Name & ".xlsx"
Next i

End Sub

Upvotes: 0

Views: 386

Answers (1)

Parfait
Parfait

Reputation: 107587

Consider assigning and releasing the same querydef inside the loop especially since you can potentially have hundreds of Chunk_i queries. No need to Append, Delete, or Refresh.

Specifically, save a query named Chunk beforehand with anything like SELECT 1 FROM MASTER, then update its SQL in code, releasing each time:

ssql = "SELECT TOP 25000 * FROM MASTER"
Set qdef = CurrentDb.QueryDefs("Chunk")    ' ASSIGN SAVED QUERY OBJECT
qdef.SQL = ssql                            ' UPDATE ITS SQL
Set qdef = Nothing                         ' RELEASE TO SAVE

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, _
                          "Chunk", "K:\Public\MDM\PMD\Chunk_1.xlsx"

For i = 2 To numChunks
    ssql = "SELECT TOP 25000 * FROM MASTER WHERE [Material Number]" _ 
            & " NOT IN (SELECT TOP " & (i - 1) * 25000 & " [Material Number] FROM MASTER)"

    Set qdef = CurrentDb.QueryDefs("Chunk")  ' ASSIGN SAVED QUERY OBJECT
    qdef.SQL = ssql                          ' UPDATE ITS SQL
    Set qdef = Nothing                       ' RELEASE TO SAVE

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, _
                              "Chunk", "K:\Public\MDM\PMD\Chunk_" & i & ".xlsx"

Next i

Upvotes: 1

Related Questions