MS Access зависает на docmd.transferspreadsheet

Question

Я взял некоторый код экспорта из @LocEngineer (спасибо!) Из этой ветки здесь: Разделить таблицу MS Access на части и экспортировать в Excel с помощью VBA Но после реализации доступ будет зависать бесконечно, когда он попадет в последняя строка цикла для экспорта следующего фрагмента. У кого-нибудь есть идеи, почему это произойдет? Кажется, все работает правильно, в противном случае. Любое понимание очень ценится, я все еще изучаю свой путь в VBA. [MASTER] - это таблица, которая должна быть разбита на 25000 строк для экспорта в Excel. [MaterialNumber] не является уникальным и содержит дубликаты в таблице.

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

Answer 1

Рассмотрите возможность назначения и освобождения одного и того же querydef внутри цикла, тем более что вы можете иметь сотни Chunk_i запросов. Нет необходимости Append, Delete или Refresh.

В частности, заранее сохраните запрос с именем Chunk , например, SELECT 1 FROM MASTER, затем обновите его SQL в коде, каждый раз выпуская:

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