|
无忧的代码,不能运行啊,什么原因???
你随便创建一个窗体,窗体的按钮事件里放入以下代码:(本代码的实例为Northwind.mdb数据库,一个工作表要放入多少条记录,只要改动下面的n的值就好
Option Compare Database
Private Sub Command0_Click()
DoCmd.SetWarnings False
Expath = CurrentProject.path & "\" '防止跟现有的工作薄重名
X = 1
Do
If Dir(Expath & Year(Now()) & "导出工作薄名" & X & ".xls") <> "" Then
X = X + 1
Else
Exit Do
End If
Loop
Dim xx, yy, n '总记录数,总工作表数,n为一个工作表里计划的记录数
Set db = OpenDatabase(CurrentProject.path & "\Northwind.mdb") '对当前数据库来说,这个能不能简化?
Set rs = db.OpenRecordset("产品")
xx = rs.RecordCount
n = 20 '一个工作表里要放多少条记录,比如,一个工作表里只放10条记录
If Int(xx / n) <> xx / n Then
yy = Int(xx / n) + 1
Else
yy = xx / n
End If
Dim SQLXY()
ReDim SQLXY(yy)
For I = 1 To yy Step 1
If I = yy Then
DoCmd.RunSQL "SELECT TOP " & xx - (yy - 1) * n & " * INTO [Excel 8.0;Database=" & Expath & Year(Now()) & "导出工作薄名" & X & ".xls].[" & yy & "] FROM 产品 ORDER BY 产品ID DESC;"
Else
DoCmd.RunSQL "SELECT TOP " & n & " * INTO [Excel 8.0;Database=" & Expath & Year(Now()) & "导出工作薄名" & X & ".xls].[" & I & "] FROM [SELECT TOP " & I * n & " * FROM 产品 ORDER BY 产品ID ]. AS 临时表 ORDER BY 临时表.产品ID DESC;"
End If
Next
MsgBox "导出成功!"
DoCmd.SetWarnings True
End Sub |
|