将MS Access表拆分为多个部分并使用VBA导出到Excel

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

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

Answer 2

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 3

If you have a criteria by witch you part the data, have this partition done by a query, set of queries, or a parameterized query, in witch you replace the parameter by code, using the query's SQL property and VBA Replace() function.

If you have no criteria, create one in a temp table:

1. Insert all data from table to a temp table, add a Boolean field Exported , default value False ;

2. Create query MyQuery with a specific order (probably on primary key), so that you have an object with all data you want to work with:

    SELECT TOP 20000 * FROM TempTable WHERE Exported = FALSE ORDER BY [Part Number] 

3. Export the data in MyQuery to Excel;

4. Set the records in MyQuery to TRUE :

    UPDATE MyQuery SET Exported = TRUE 

Until the MyQuery is empty, Then delete TempTable , or it's contents.