要するに、最初のクエリでは、ID (自動番号) 列を選択しないでください。初期一時テーブルに必要な列を選択し、テーブルを変更して新しいカウンター列を追加します。COUNTER(1,1) を使用して、一時テーブルが作成されるたびに最初のレコードが 1 になるようにしました。
壊れたファイルをフォルダーに保存する小さなナゲットを追加しました。エラー処理をコメントアウトしましたが、保存ディレクトリが正しく機能していることを確認するためにコメントを外してください。
Function SplitTables_RTPA_Actual()
Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
Set cn = CurrentProject.Connection
Dim rowcount As Long
Dim tblcount As Integer
Dim i As Integer
'Just don't select the ID column
SQL = "SELECT Company, Incurred_By, Transaction_Type, Format(Transaction_Date, 'mm/dd/yyyy'), Investment_ID, " & _
"Task_ID, Charge_Code, Resource_ID, Role, Notes, Quantity INTO tmp_Flush_Tran_Actual FROM Actual_Transaction_Data"
DoCmd.RunSQL SQL
SQL = "ALTER TABLE tmp_Flush_Tran_Actual ADD COLUMN ID COUNTER(1,1)"
DoCmd.RunSQL SQL
SQL = "SELECT count(*) as rowcount from Actual_Transaction_Data"
rs.Open SQL, cn
rowcount = rs!rowcount
rs.Close
tblcount = rowcount / 100 + 1
For i = 1 To tblcount
'Create Temp Flush File
SQL = "SELECT * into tmp_Flush_Tran_Actual" & i & " FROM tmp_Flush_Tran_Actual" & _
" WHERE ID <=100*" & i
DoCmd.RunSQL SQL
SQL = "ALTER TABLE tmp_Flush_Tran_Actual" & i _
& " DROP COLUMN ID;"
DoCmd.RunSQL SQL
'Delete 500 from Temp Flush File
SQL = "DELETE * FROM tmp_Flush_Tran_Actual" & _
" WHERE ID <=100*" & i
DoCmd.RunSQL SQL
'On Error GoTo ErrorHandler
Dim strTable As String
Dim strWorksheetPath As String
'Location where you want to save the broken out files
strWorksheetPath = "C:\YOUR TEMP FOLDER\TEST\"
strWorksheetPath = strWorksheetPath & "Actual_Transactions" & i & ".xls"
strTable = "tmp_Flush_Tran_Actual" & i
DoCmd.TransferSpreadsheet transfertype:=acExport, spreadsheettype:=acSpreadsheetTypeExcel9, TableName:=strTable, FileName:=strWorksheetPath, hasfieldnames:=True
'ErrorHandlerExit:
' Exit Function
' 'Next i
'
'ErrorHandler:
' MsgBox "Error No: " & Err.Number _
' & "; Description: " & Err.Description
' Resume ErrorHandlerExit
Next i
End Function