[VBA] Export access table into one or more worksheets if row count over 65535

https://github.com/walter426/VbaUtilities/

'Export a table to one or more worksheets in case row count over 65535
Public Function ExportTblToSht(Wb_path, Tbl_name As String, sht_name As String) As String
    On Error GoTo Err_ExportTblToSht
   
    Dim FailedReason As String

    If TableExist(Tbl_name) = False Then
        FailedReason = Tbl_name & " does not exist"
        GoTo Exit_ExportTblToSht
    End If

   
    If Len(Dir(Wb_path)) = 0 Then
        Dim oExcel As Excel.Application
        Set oExcel = CreateObject("Excel.Application")
   
        With oExcel
            Dim oWb As Workbook
            Set oWb = .Workbooks.Add
           
           
            With oWb
                .SaveAs Wb_path
                .Close
            End With 'oWb_DailyRpt
           
            .Quit
           
        End With 'oExcel
       
        Set oExcel = Nothing
       
    End If
   
   
    Dim MaxRowPerSht As Long
    Dim RecordCount As Long
       
    MaxRowPerSht = 65534
    RecordCount = Table_RecordCount(Tbl_name)
   
   
    If RecordCount <= 0 Then
        GoTo Exit_ExportTblToSht
   
    ElseIf RecordCount <= MaxRowPerSht Then
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Tbl_name, Wb_path, True, sht_name
   
    Else
        'handle error msg, "File sharing lock count exceeded. Increase MaxLocksPerFile registry entry"
        DAO.DBEngine.SetOption dbMaxLocksPerFile, 40000
       
       
        Dim Tbl_COPY_name As String
        Tbl_COPY_name = Tbl_name & "_COPY"
       
        DelTable (Tbl_COPY_name)
       
        Dim SQL_cmd As String

        SQL_cmd = "SELECT * " & vbCrLf & _
                    "INTO [" & Tbl_COPY_name & "] " & vbCrLf & _
                    "FROM [" & Tbl_name & "]" & vbCrLf & _
                    ";"
       
        RunSQL_CmdWithoutWarning (SQL_cmd)
       
        SQL_cmd = "ALTER TABLE [" & Tbl_COPY_name & "] " & vbCrLf & _
                    "ADD record_idx COUNTER " & vbCrLf & _
                    ";"
       
        RunSQL_CmdWithoutWarning (SQL_cmd)
       
       
        Dim ShtCount As Integer
        Dim sht_idx As Integer
        Dim Sht_part_name As String
        Dim Tbl_part_name As String
       
        ShtCount = Int(RecordCount / MaxRowPerSht)
       
        For sht_idx = 0 To ShtCount
            Sht_part_name = sht_name
           
            If sht_idx > 0 Then
                Sht_part_name = Sht_part_name & "_" & sht_idx
            End If
               
            Tbl_part_name = Tbl_name & "_" & sht_idx
           
            DelTable (Tbl_part_name)
           
            SQL_cmd = "SELECT * " & vbCrLf & _
                        "INTO [" & Tbl_part_name & "] " & vbCrLf & _
                        "FROM [" & Tbl_COPY_name & "]" & vbCrLf & _
                        "WHERE [record_idx] >= " & sht_idx * MaxRowPerSht + 1 & vbCrLf & _
                        "AND [record_idx] <= " & (sht_idx + 1) * MaxRowPerSht & vbCrLf & _
                        ";"
       
            'MsgBox SQL_cmd
            RunSQL_CmdWithoutWarning (SQL_cmd)
       
       
            SQL_cmd = "ALTER TABLE [" & Tbl_part_name & "] " & vbCrLf & _
                        "DROP COLUMN [record_idx] " & vbCrLf & _
                        ";"
   
            RunSQL_CmdWithoutWarning (SQL_cmd)
           
           
            DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Tbl_part_name, Wb_path, True, Sht_part_name
           
            DelTable (Tbl_part_name)
           
        Next sht_idx
   
        DelTable (Tbl_COPY_name)
       
    End If

   
Exit_ExportTblToSht:
    ExportTblToSht = FailedReason
    Exit Function

Err_ExportTblToSht:
    FailedReason = Err.Description
    Resume Exit_ExportTblToSht
   
End Function