如果导出到一新excel文件或新工作表:
cn.Execute "select * into [Excel 8.0;DATABASE=excel文件名].表名 from 源表名"
'导出到已存在文件表:
cn.Execute "Insert into [Excel 8.0;DATABASE=excel文件名].表名 select * from 源表名"
哪裡用那麼多代碼啊?
Private Sub Command3_Click()
Dim strFileName As String
Dim objFileSystem As Object
Dim objExcelText As Object
Dim strExcel As String
strConn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=develop; password=12345;Data Source=ServerName"
pubConn.Open strConn
rsTable.CursorLocation = adUseClient
strSQL = "select * from Table1 left join Table2 on..."
rsTable.Open strSQL, pubConn, adOpenDynamic, adLockOptimistic
Set DataGrid1.DataSource = rsTable
strExcel = rsTable.GetString
Set xlApp = CreateObject("Excel.Application")
Set xlBook = Nothing
Set xlSheet = Nothing
Set xlBook = xlApp.Workbooks().add
Set xlSheet = xlBook.Worksheets("sheet1")
xlApp.Visible = True
'添加查询语句,导入EXCEL数据
Set xlQuery = xlSheet.QueryTables.add(Rst, xlSheet.Range("a1"))
Public Function vExporToExcel_DAO(strOpen As String, TabAddress As String, Optional Caption As String = "导出的 Excel 文件", Optional Companyname As String = "", Optional DataPassWord As String = "")
'***************************************************************************
'* 名称:vExporToExcel_DAO
'* 功能:通过 DAO 快速导出数据到EXCEL
'* 用法:vExporToExcel_DAO(sql查询字符串,DAO 连接数据库路径和名称,导出文件名称,总公司名称,数据库密码)
'***************************************************************************
On Error GoTo errHandlerr
Dim OpenWs As Workspace
Dim OpenDB As Database
Dim RsData As Recordset
Dim Irowcount As Integer
Dim Icolcount As Integer
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlQuery As Excel.QueryTable
Set OpenWs = DBEngine.Workspaces(0)
Set OpenDB = OpenWs.OpenDatabase(TabAddress, False, False, "MS Access;PWD=" + DataPassWord)
Set RsData = OpenDB.OpenRecordset(strOpen, dbOpenSnapshot)
With RsData
If .RecordCount < 1 Then
MsgBox "没有记录可供导出!", vbInformation, MsgBoxTitle
Exit Function
End If
.MoveLast
.MoveFirst
Irowcount = .RecordCount '记录总数
Icolcount = .Fields.count '字段总数
End With
Set xlApp = CreateObject("Excel.Application")
Set xlBook = Nothing
Set xlSheet = Nothing
Set xlBook = xlApp.Workbooks().add
Set xlSheet = xlBook.Worksheets("sheet1")
xlApp.Visible = True
'添加查询语句,导入EXCEL数据
Set xlQuery = xlSheet.QueryTables.add(RsData, xlSheet.Range("a1"))
Set xlApp = CreateObject("Excel.Application")
Set xlBook = Nothing
Set xlSheet = Nothing
Set xlBook = xlApp.Workbooks().add
Set xlSheet = xlBook.Worksheets("sheet1")
xlApp.Visible = True
'添加查询语句,导入EXCEL数据
Set xlQuery = xlSheet.QueryTables.add(Rs_Data, xlSheet.Range("a1"))