ACCESS复制所有记录到EXCEL
我现在想把ACESS中的所有记录复制到EXCEL的响应的单元格中,出现了一些问题请高手指教。
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim l, m As Integer
Dim DBCon As New ADODB.Connection
Dim DBRs As New ADODB.Recordset
DBCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DB.mdb"
DBRs.Open "select * from STA1", DBCon
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(App.Path & "\report\STA1.xls")
xlApp.Visible = False '设置EXCEL对象可见(或不可见)
Set xlSheet = xlBook.Worksheets("Sheet1") '设置活动工作表
第一种方法采用循环方式:
dim i,j as integer
For i = 1 To DBRs.RecordCount
For j = 1 To DBRs.Fields.Count
xlSheet.Cells(l + 22, j) = DBRs.Fields(j - 1).Value
Next j
DBRs.MoveNext
Next i
xlSheet.Cells.Columns.AutoFit
xlBook.Save
DBRs.Close
Set DBRs = Nothing
Set DBCon = Nothing
xlApp.Quit
Set xlApp = Nothing
MsgBox "数据已成功保存到" & CommonDialog1.FileName, , "保存提示"
这种方法出现的情况是:记录没有复制到A23之后的单元格中
第二种方法使用CopyFromRecordset
xlSheet .Range("A23").CopyFromRecordset DBRs
xlSheet.Cells.Columns.AutoFit
xlSheet.Cells.Columns.AutoFit
xlBook.Save
DBRs.Close
Set DBRs = Nothing
Set DBCon = Nothing
xlApp.Quit
Set xlApp = Nothing
MsgBox "数据已成功保存到" & CommonDialog1.FileName, , "保存提示"
这种方法出现的情况是:记录顺序不正常。
ACESS数据库中表1的记录如下:
1 interval 09-07-12
2 interval 09-07-10
3 interval 09-07-09
4 interval 09-07-02
5 interval 09-07-05
但是复制到EXCEL后发现顺序变成了
1 interval 09-07-12
3 interval 09-07-09
4 interval 09-07-02
5 interval 09-07-05
2 interval 09-07-10
请高手指点 谢谢