access中根据行数拆分到不同的excel文件
Function ExportDataToMultipleExcelFiles()
Dim qdf As QueryDef
Dim rs As Recordset
Dim rowCount As Long
Dim maxRowsPerFile As Long
Dim totalRows As Long
Dim fileNum As Long
Dim fileName As String
Dim folderPath As String
' 输入文件夹路径
folderPath = InputBox("请输入文件夹路径:", "输入参数")
' 输入文件名(不包含序号)
fileName = InputBox("请输入文件名(不包含序号):", "输入参数")
Set qdf = CurrentDb.QueryDefs(InputBox("请输入要拆分的表或者查询:", "输入参数")) ' 替换为你的查询名称
Set rs = qdf.OpenRecordset()
rowCount = 0 ' 起始行号
maxRowsPerFile = 100000 ' 每个文件的最大行数
rs.MoveLast
rs.MoveFirst
totalRows = rs.RecordCount() ' 查询结果的总行数
fileNum = 0
Do While rowCount < totalRows
fileNum = fileNum + 1
Dim xlApp As Object
Dim xlWorkbook As Object
Dim xlWorksheet As Object
Set xlApp = CreateObject("Excel.Application")
Set xlWorkbook = xlApp.Workbooks.Add
Set xlWorksheet = xlWorkbook.Worksheets(1)
xlWorksheet.Name = fileName ' 可自定义工作表名称
fieldCount = rs.Fields.Count
' 写入列名
For col = 1 To fieldCount
xlWorksheet.Cells(1, col).Value = rs.Fields(col - 1).Name
Next col
' 将查询结果导入Excel中
With xlWorksheet
.Range("A2").CopyFromRecordset rs, maxRowsPerFile
End With
xlWorkbook.SaveAs folderPath & "\" & fileName & "_" & fileNum & ".xlsx" ' 替换为你想保存的文件路径和文件名
xlWorkbook.Close
xlApp.Quit
Set xlWorksheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing
rowCount = rowCount + maxRowsPerFile
' If rowCount < totalRows Then
' rs.Move maxRowsPerFile ' 移动记录指针到下一个起始行
' End If
DoEvents ' 允许系统处理其他事件
Loop
rs.Close
Set rs = Nothing
Set qdf = Nothing
MsgBox "导出完成!"
End Function