Export from Access to Excel into single file but multiple sheets when table exceeds 1.04M rows

[DanLMiddlingExcelUser]

Hello,

I am curious if anyone can guide me on how to export from MS Access to MS Excel a table that I know is > than the 1.04M records that a single excel sheet, but put those records into the same file, just multiple sheets? My ultimate goal would be, as an example, a table with ~3M records could be exported to ONE excel file, into THREE sheets pictured below. So the first tab would fill up the 1.04M rows, the second tab would fill up the 1.04M rows and the third tab would populate with whatever is left. Extra credit, I would like the first row to be the same across all sheets. Also, some tables might be 2M rows (2 sheets), some could be 3M rows (3 sheets), etc.

Appreciate the help!

 

[ranman256]

this routine uses 3 queries to export large data using a marker:
the table has a field called MARK, that is blank at start , then fills in X if it got exported

"qsAllRecs" query pulls all records

"qsSomeRecs" is like qsAllRecs, but has a limit of 1M records
SELECT TOP " & lBlockSize & " * FROM tTable where [Mark]=''

"quMarkBlockSent" sets the MARK field = X if exported.

when there are no more records to export, the loop stops.

Public Sub XportLargeBlocks()
Dim lBlockSize As Long, lStart As Long, lEnd As Long
Dim iCt As Integer
Dim qdf As QueryDef
Dim vFile
Dim sSql As String
   'upd the top X recs with:
 'quMarkSentData = "UPDATE [qsSomeRecs] SET Mark = 'X'"
 
Const kMARKqry = "quMarkBlockSent"
Const kALLqry = "qsAllRecs"
Const kSOMEqry = "qsSomeRecs"
vFile = "c:\temp\ExportLargeData.xlsx"
 
 
lBlockSize = 1000000
lStart = 0
lEnd = lBlockSize
   'get the top 1M recs
   
'DoCmd.CopyObject , kMARKqry, acQuery, kALLqry
Set qdf = CurrentDb.QueryDefs(kSOMEqry)    'export query
qdf.SQL = "SELECT TOP " & lBlockSize & " * FROM tTable where [Mark]=''"
qdf.Close

If DCount("*", "qsAllRecs") <= lBlockSize Then
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qsAllRecs", vFile, True
Else
    'clear all markers
    sSql = "Update qsAllRecs set Mark=''"
    DoCmd.RunSQL sSql
   iCt = 1
       'the base qry to limit output
   
   While DCount("*", qdf.Name) > 0
         
          'export X records that are not marked
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qsSomeRecs", vFile, True, "sheet" & iCt
       
          'mark the top X recs so we dont export again
        DoCmd.OpenQuery kMARKqry
   Wend
End If
MsgBox "Done"
Set qdf = Nothing
End Sub

 

[DanLMiddlingExcelUser]

this routine uses 3 queries to export large data using a marker:
the table has a field called MARK, that is blank at start , then fills in X if it got exported

"qsAllRecs" query pulls all records

"qsSomeRecs" is like qsAllRecs, but has a limit of 1M records
SELECT TOP " & lBlockSize & " * FROM tTable where [Mark]=''

"quMarkBlockSent" sets the MARK field = X if exported.

when there are no more records to export, the loop stops.

Public Sub XportLargeBlocks()
Dim lBlockSize As Long, lStart As Long, lEnd As Long
Dim iCt As Integer
Dim qdf As QueryDef
Dim vFile
Dim sSql As String
   'upd the top X recs with:
 'quMarkSentData = "UPDATE [qsSomeRecs] SET Mark = 'X'"
 
Const kMARKqry = "quMarkBlockSent"
Const kALLqry = "qsAllRecs"
Const kSOMEqry = "qsSomeRecs"
vFile = "c:\temp\ExportLargeData.xlsx"
 
 
lBlockSize = 1000000
lStart = 0
lEnd = lBlockSize
   'get the top 1M recs
  
'DoCmd.CopyObject , kMARKqry, acQuery, kALLqry
Set qdf = CurrentDb.QueryDefs(kSOMEqry)    'export query
qdf.SQL = "SELECT TOP " & lBlockSize & " * FROM tTable where [Mark]=''"
qdf.Close

If DCount("*", "qsAllRecs") <= lBlockSize Then
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qsAllRecs", vFile, True
Else
    'clear all markers
    sSql = "Update qsAllRecs set Mark=''"
    DoCmd.RunSQL sSql
   iCt = 1
       'the base qry to limit output
  
   While DCount("*", qdf.Name) > 0
        
          'export X records that are not marked
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qsSomeRecs", vFile, True, "sheet" & iCt
      
          'mark the top X recs so we dont export again
        DoCmd.OpenQuery kMARKqry
   Wend
End If
MsgBox "Done"
Set qdf = Nothing
End Sub

Thank you, let me look into applying this. Appreciate the quick response! Stay tuned...as my excel middling-ness may astound you and I might have further questions

 

[DanLMiddlingExcelUser]

Thank you, let me look into applying this. Appreciate the quick response! Stay tuned...as my excel middling-ness may astound you and I might have further questions

this routine uses 3 queries to export large data using a marker:
the table has a field called MARK, that is blank at start , then fills in X if it got exported

"qsAllRecs" query pulls all records

"qsSomeRecs" is like qsAllRecs, but has a limit of 1M records
SELECT TOP " & lBlockSize & " * FROM tTable where [Mark]=''

"quMarkBlockSent" sets the MARK field = X if exported.

when there are no more records to export, the loop stops.

Public Sub XportLargeBlocks()
Dim lBlockSize As Long, lStart As Long, lEnd As Long
Dim iCt As Integer
Dim qdf As QueryDef
Dim vFile
Dim sSql As String
   'upd the top X recs with:
 'quMarkSentData = "UPDATE [qsSomeRecs] SET Mark = 'X'"
 
Const kMARKqry = "quMarkBlockSent"
Const kALLqry = "qsAllRecs"
Const kSOMEqry = "qsSomeRecs"
vFile = "c:\temp\ExportLargeData.xlsx"
 
 
lBlockSize = 1000000
lStart = 0
lEnd = lBlockSize
   'get the top 1M recs
  
'DoCmd.CopyObject , kMARKqry, acQuery, kALLqry
Set qdf = CurrentDb.QueryDefs(kSOMEqry)    'export query
qdf.SQL = "SELECT TOP " & lBlockSize & " * FROM tTable where [Mark]=''"
qdf.Close

If DCount("*", "qsAllRecs") <= lBlockSize Then
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qsAllRecs", vFile, True
Else
    'clear all markers
    sSql = "Update qsAllRecs set Mark=''"
    DoCmd.RunSQL sSql
   iCt = 1
       'the base qry to limit output
  
   While DCount("*", qdf.Name) > 0
        
          'export X records that are not marked
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qsSomeRecs", vFile, True, "sheet" & iCt
      
          'mark the top X recs so we dont export again
        DoCmd.OpenQuery kMARKqry
   Wend
End If
MsgBox "Done"
Set qdf = Nothing
End Sub

Thank you again.

I tried adding this to my MS Access DB, but I got runtime error, so I am pretty sure I did not take all the steps need to make this work. With your code, what are the steps I need to do in my DB to get the code to run and export?

I thought I would paste that into VBA window, but clearly did something wrong. Thanks again!