Split MS Access table into parts and export into Excel using VBA

Question

I have an Access table of about 50000 records which I require to split into preferably 3 parts and export these parts into individual excel files or sheets using VBA.

I require this, as these Excel files are used elsewhere where the maximum number of records in a file can only be about 20000 records.

I have played around with the docmd.transferspreadsheet method but can't seem to split them.

Any ideas or help appreciated.

Edit: This table that I am working with consists of columns: Part Number (made of various characters which is unique), description, price,comments. It does not have a ID number say from 1 till 50000 each relating to a record.

Answer 1

Try this:

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(Id) FROM BigTable"
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 / 20000) + 0.5, 0)

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

ssql = "SELECT TOP 20000 * FROM BigTable"
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", "C:\00_Projekte_temp\Chunk_1.xlsx"

For i = 2 To numChunks
    ssql = "SELECT TOP 20000 * FROM BigTable WHERE ID NOT IN (SELECT TOP " & (i - 1) * 20000 & " ID FROM BigTable)"
    Set qdef = CurrentDb.QueryDefs("Chunk")
    qdef.SQL = ssql
    CurrentDb.QueryDefs.Refresh
    Set qdef = CurrentDb.QueryDefs("Chunk_" & i)
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, qdef.Name, "C:\00_Projekte_temp\" & qdef.Name & ".xlsx"
Next i

End Sub

What does it do? First it calculates how many chunks you'll need, then creates queries that will take the first 20,000 records, then the next and so forth, and lastly exports each chunked query to an Excel file.

Edit: Amended to onyl create one query that gets overwritten in each iteration and exported to a new Excel file.

Answer 2

As you probably have a unique numeric Id on the table, create these three queries and export these one by one:

 Select * From YourTable Where Id Mod 3 = 0

 Select * From YourTable Where Id Mod 3 = 1

 Select * From YourTable Where Id Mod 3 = 2

Option: Add virtual row number:

Create ans ave a query like this:

SELECT RowCounter([ProductKey],False) AS Id, *
FROM YourTable
WHERE (RowCounter([ProductKey],False) <> RowCounter("",True));

using the function below. Then adjust the three queries to use the new query.

Public Function RowCounter( _
  ByVal strKey As String, _
  ByVal booReset As Boolean, _
  Optional ByVal strGroupKey As String) _
  As Long

' Builds consecutive RowIDs in select, append or create query
' with the possibility of automatic reset.
' Optionally a grouping key can be passed to reset the row count
' for every group key.
'
' Usage (typical select query):
'   SELECT RowCounter(CStr([ID]),False) AS RowID, *
'   FROM tblSomeTable
'   WHERE (RowCounter(CStr([ID]),False) <> RowCounter("",True));
'
' Usage (with group key):
'   SELECT RowCounter(CStr([ID]),False,CStr[GroupID])) AS RowID, *
'   FROM tblSomeTable
'   WHERE (RowCounter(CStr([ID]),False) <> RowCounter("",True));
'
' The Where statement resets the counter when the query is run
' and is needed for browsing a select query.
'
' Usage (typical append query, manual reset):
' 1. Reset counter manually:
'   Call RowCounter(vbNullString, False)
' 2. Run query:
'   INSERT INTO tblTemp ( RowID )
'   SELECT RowCounter(CStr([ID]),False) AS RowID, *
'   FROM tblSomeTable;
'
' Usage (typical append query, automatic reset):
'   INSERT INTO tblTemp ( RowID )
'   SELECT RowCounter(CStr([ID]),False) AS RowID, *
'   FROM tblSomeTable
'   WHERE (RowCounter("",True)=0);
'
' 2002-04-13. Cactus Data ApS. CPH
' 2002-09-09. Str() sometimes fails. Replaced with CStr().
' 2005-10-21. Str(col.Count + 1) reduced to col.Count + 1.
' 2008-02-27. Optional group parameter added.
' 2010-08-04. Corrected that group key missed first row in group.

  Static col      As New Collection
  Static strGroup As String

  On Error GoTo Err_RowCounter

  If booReset = True Then
    Set col = Nothing
  ElseIf strGroup <> strGroupKey Then
    Set col = Nothing
    strGroup = strGroupKey
    col.Add 1, strKey
  Else
    col.Add col.Count + 1, strKey
  End If

  RowCounter = col(strKey)

Exit_RowCounter:
  Exit Function

Err_RowCounter:
  Select Case Err
    Case 457
      ' Key is present.
      Resume Next
    Case Else
      ' Some other error.
      Resume Exit_RowCounter
  End Select

End Function