'引用 Microsoft ActiveX Data Objects 2.X Library
Private Sub Command1_Click()
Dim cnSql As New ADODB.Connection, cnExcel As New ADODB.Connection, rsSql As New ADODB.Recordset, rsExcel As New ADODB.Recordset, i%
'打开SQL数据库的连接，具体的需要改一下
cnSql.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=数据库;Data Source=SQL服务器别名/IP"
rsSql.CursorLocation = adUseClient
'获取SQL里的Table1的所有记录，准备导出入Excel
rsSql.Open "select * from table1", cnSql, adOpenDynamic, adLockReadOnly
'连接C:/Test.xls
cnExcel.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:/test.xls;Extended Properties=Excel 8.0"
rsExcel.CursorLocation = adUseClient
'打开Excel的Sheet1表，准备导入数据
rsExcel.Open "select * from [Sheet1$]", cnExcel, adOpenDynamic, adLockPessimistic
rsSql.MoveFirst
While Not rsSql.EOF
rsExcel.AddNew
For i = 0 To rsSql.Fields.Count - 1
rsExcel(i) = rsSql(i) '给Excel的记录集赋值
Next
rsSql.MoveNext
Wend
rsExcel.UpdateBatch '批量更新记录集
Set rsSql = Nothing
Set rsExcel = Nothing
cnSql.Close
Set cnSql = Nothing
cnExcel.Close
Set cnExcel = Nothing
End Sub
看看从SQL server2000一条条记录导入的方法:
Dim xlApp As Variant
Dim xlBook As Variant
Dim xlSheet As Variant
CommonDialog1.FileName = "电子表文件名.xls"
CommonDialog1.Filter = "Excel文件 (*.xls)|*.xlt|"
CommonDialog1.ShowSave
Set xlApp = CreateObject("Excel.Application")
xlApp.displayalerts = False
Set xlBook = xlApp.Workbooks.Open(App.Path + "/表格模板.xlt")
xlBook.SaveCopyAs (CommonDialog1.FileName)
xlBook.Close
Set xlBook = xlApp.Workbooks.Open(CommonDialog1.FileName)
Set xlSheet = xlBook.Worksheets(1)
xlApp.Visible = False
For i = 1 To Adodc.Recordset.RecordCount
xlSheet.cells(i, 1) = adodc3.Recordset.Fields("字段名1").Value
xlSheet.cells(i, 2) = adodc3.Recordset.Fields("字段名2").Value
.
.
.
xlSheet.cells(i, n) = adodc3.Recordset.Fields("字段名n").Value
If Not Adodc.Recordset.EOF Then Adodc.Recordset.MoveNext
Next i
(注:加入CommonDialog对象)
