Public Sub SQLtoExcel(SqlDatabasename As String, SqlTablename As String, ExcelPath As String, ExcelSheetName As String) Dim RsSQLtoExcel As New ADODB.Recordset Dim CnSQLtoExcel As New ADODB.Connection Dim xlBook As Excel.Workbook Set xlApp = CreateObject("Excel.Application") '´´½¨EXCEL¶ÔÏó Set xlBook = xlApp.Workbooks.AddxlApp.Worksheets(ExcelSheetName).Activate Dim i As Integer Dim MM As Integer Dim nn As Integer Dim jj As IntegerCnSQLtoExcel.ConnectionString = CSWithDB CnSQLtoExcel.CursorLocation = adUseClient CnSQLtoExcel.open RsSQLtoExcel.open "select * from " & SqlTablename, CnSQLtoExcel, adOpenDynamic, adLockOptimisticFor i = 1 To RsSQLtoExcel.Fields.Count xlApp.Cells(1, i).Value = RsSQLtoExcel.Fields.Item(i - 1).Name Next MM = 1 RsSQLtoExcel.MoveFirst Do While RsSQLtoExcel.EOF <> True MM = MM + 1 For nn = 1 To RsSQLtoExcel.Fields.Count If RsSQLtoExcel.Fields.Item(nn - 1).Value <> "" Then xlApp.Cells(MM, nn).Value = RsSQLtoExcel.Fields.Item(nn - 1).Value Else xlApp.Cells(MM, nn).Value = " " End If Next RsSQLtoExcel.MoveNext Loop xlApp.DisplayAlerts = False xlBook.SaveAs (ExcelPath) xlBook.Close (False) Set xlApp = Nothing If CnSQLtoExcel.State <> adStateClosed Then CnSQLtoExcel.Close If RsSQLtoExcel.State <> adStateClosed Then RsSQLtoExcel.Close End Sub
能过 sql 企业管理器的管理工具 导出 也可以实现的啊
给你代码,你自己看看,导出很快 Sub export() Dim myexcel As New Excel.Application Dim mybook As New Excel.Workbook Dim mysheet As New Excel.Worksheet Set mybook = myexcel.Workbooks.Add '添加一个新的BOOK Set mysheet = mybook.Worksheets.Add '添加一个新的SHEET myexcel.Visible = False
Dim myres As New ADODB.Recordset Set conn = New ADODB.Connection conn.Open "你的连接字符串"
mysheet.Cells.CopyFromRecordset myres mybook.SaveAs "c:\文件名.xls" '保存文件 End If
mybook.Close myexcel.Quit
Set mybook = Nothing Set myexcel = Nothing end sub
这个很好用哎Option ExplicitDim Adoconn As New ADODB.Connection Public Function QueryToExcel(ByVal strOpen As String) '********************************************************* '* 名称:ExporToExcel '* 功能:导出数据到EXCEL '* 用法:ExporToExcel(sql查询字符串) '* 注:须在程序中引用'Microsoft Excel 9.0 Object Library'和ADO对象,机器必装Excel 2000 '********************************************************* Dim Rs_Data As New ADODB.Recordset Dim Irowcount As Long Dim Icolcount As Long Dim xlApp As New Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Dim xlQuery As Excel.QueryTable On Error GoTo err: With Rs_Data If .State = adStateOpen Then .Close End If .ActiveConnection = Adoconn .CursorLocation = adUseClient .CursorType = adOpenStatic .LockType = adLockReadOnly .Source = strOpen .Open End With With Rs_Data If .RecordCount < 1 Then MsgBox ("没有记录!") Exit Function End If '记录总数 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(Rs_Data, xlSheet.Range("a1")) '从第几行,第几列开始显示 update by cjs
xlApp.Application.Visible = True Set xlApp = Nothing '"交还控制给Excel Set xlBook = Nothing Set xlSheet = Nothing Exit Function err: MsgBox err.DescriptionEnd FunctionPrivate Sub Class_Initialize() '类初始化时建立与程序同样的数据库连接 Dim StrConnect As String StrConnect = "driver={sql server};server=127.0.0.1;uid=SA;pwd=;database=test" Adoconn.ConnectionString = StrConnect Adoconn.Open End SubPrivate Sub Class_Terminate() '类释放时关闭数据库连接 On Error GoTo err: If Adoconn.State = 1 Then Adoconn.Close Set Adoconn = Nothing End If Exit Sub err: End Sub
常规的数据导入导出:
使用DTS向导迁移你的Access数据到SQL Server,你可以使用这些步骤:
○1在SQL SERVER企业管理器中的Tools(工具)菜单上,选择Data Transformation
○2Services(数据转换服务),然后选择 czdImport Data(导入数据)。
○3在Choose a Data Source(选择数据源)对话框中选择Microsoft Access as the Source,然后键入你的.mdb数据库(.mdb文件扩展名)的文件名或通过浏览寻找该文件。
○4在Choose a Destination(选择目标)对话框中,选择Microsoft OLE DB Prov ider for SQL Server,选择数据库服务器,然后单击必要的验证方式。
○5在Specify Table Copy(指定表格复制)或Query(查询)对话框中,单击Copy tables(复制表格)。
○6在Select Source Tables(选择源表格)对话框中,单击Select All(全部选定)。下一步,完成。Transact-SQL语句进行导入导出:
1.在SQL SERVER里查询access数据:SELECT *
FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\DB.mdb";User ID=Admin;Password=')...表名2.将access导入SQL server
在SQL SERVER 里运行:
SELECT *
INTO newtable
FROM OPENDATASOURCE ('Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\DB.mdb";User ID=Admin;Password=' )...表名3.将SQL SERVER表里的数据插入到Access表中
在SQL SERVER 里运行:
insert into OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source=" c:\DB.mdb";User ID=Admin;Password=')...表名
(列名1,列名2)
select 列名1,列名2 from sql表实例:
insert into OPENROWSET('Microsoft.Jet.OLEDB.4.0',
'C:\db.mdb';'admin';'', Test)
select id,name from Test
INSERT INTO OPENROWSET('Microsoft.Jet.OLEDB.4.0', 'c:\trade.mdb'; 'admin'; '', 表名)
SELECT *
FROM sqltablename二、SQL SERVER 和EXCEL的数据导入导出1、在SQL SERVER里查询Excel数据:SELECT *
FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\book1.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...[Sheet1$]下面是个查询的示例,它通过用于 Jet 的 OLE DB 提供程序查询 Excel 电子表格。
SELECT *
FROM OpenDataSource ( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\Finance\account.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions2、将Excel的数据导入SQL server :
SELECT * into newtable
FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\book1.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...[Sheet1$]实例:
SELECT * into newtable
FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\Finance\account.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...xactions3、将SQL SERVER中查询到的数据导成一个Excel文件
T-SQL代码:
EXEC master..xp_cmdshell 'bcp 库名.dbo.表名out c:\Temp.xls -c -q -S"servername" -U"sa" -P""'
参数:S 是SQL服务器名;U是用户;P是密码
说明:还可以导出文本文件等多种格式实例:EXEC master..xp_cmdshell 'bcp saletesttmp.dbo.CusAccount out c:\temp1.xls -c -q -S"pmserver" -U"sa" -P"sa"' EXEC master..xp_cmdshell 'bcp "SELECT au_fname, au_lname FROM pubs..authors ORDER BY au_lname" queryout C:\ authors.xls -c -Sservername -Usa -Ppassword'在VB6中应用ADO导出EXCEL文件代码:
Dim cn As New ADODB.Connection
cn.open "Driver={SQL Server};Server=WEBSVR;DataBase=WebMis;UID=sa;WD=123;"
cn.execute "master..xp_cmdshell 'bcp "SELECT col1, col2 FROM 库名.dbo.表名" queryout E:\DT.xls -c -Sservername -Usa -Ppassword'"
4、在SQL SERVER里往Excel插入数据:insert into OpenDataSource( 'Microsoft.Jet.OLEDB.4.0',
'Data Source="c:\Temp.xls";User ID=Admin;Password=;Extended properties=Excel 5.0')...table1 (A1,A2,A3) values (1,2,3)T-SQL代码:
INSERT INTO
OPENDATASOURCE('Microsoft.JET.OLEDB.4.0',
'Extended Properties=Excel 8.0;Data source=C:\training\inventur.xls')...[Filiale1$]
(bestand, produkt) VALUES (20, 'Test') 总结:利用以上语句,我们可以方便地将SQL SERVER、ACCESS和EXCEL电子表格软件中的数据进行转换,为我们提供了极大方便!
也可以用Excel对象,需要引用 Excel X.0
Dim RsSQLtoExcel As New ADODB.Recordset
Dim CnSQLtoExcel As New ADODB.Connection
Dim xlBook As Excel.Workbook
Set xlApp = CreateObject("Excel.Application") '´´½¨EXCEL¶ÔÏó
Set xlBook = xlApp.Workbooks.AddxlApp.Worksheets(ExcelSheetName).Activate
Dim i As Integer
Dim MM As Integer
Dim nn As Integer
Dim jj As IntegerCnSQLtoExcel.ConnectionString = CSWithDB
CnSQLtoExcel.CursorLocation = adUseClient
CnSQLtoExcel.open
RsSQLtoExcel.open "select * from " & SqlTablename, CnSQLtoExcel, adOpenDynamic, adLockOptimisticFor i = 1 To RsSQLtoExcel.Fields.Count
xlApp.Cells(1, i).Value = RsSQLtoExcel.Fields.Item(i - 1).Name
Next
MM = 1
RsSQLtoExcel.MoveFirst
Do While RsSQLtoExcel.EOF <> True
MM = MM + 1
For nn = 1 To RsSQLtoExcel.Fields.Count
If RsSQLtoExcel.Fields.Item(nn - 1).Value <> "" Then
xlApp.Cells(MM, nn).Value = RsSQLtoExcel.Fields.Item(nn - 1).Value
Else
xlApp.Cells(MM, nn).Value = " "
End If
Next
RsSQLtoExcel.MoveNext
Loop
xlApp.DisplayAlerts = False
xlBook.SaveAs (ExcelPath)
xlBook.Close (False)
Set xlApp = Nothing
If CnSQLtoExcel.State <> adStateClosed Then CnSQLtoExcel.Close
If RsSQLtoExcel.State <> adStateClosed Then RsSQLtoExcel.Close
End Sub
Sub export()
Dim myexcel As New Excel.Application
Dim mybook As New Excel.Workbook
Dim mysheet As New Excel.Worksheet
Set mybook = myexcel.Workbooks.Add '添加一个新的BOOK
Set mysheet = mybook.Worksheets.Add '添加一个新的SHEET
myexcel.Visible = False
Dim myres As New ADODB.Recordset
Set conn = New ADODB.Connection
conn.Open "你的连接字符串"
strSQL = "你的sql语句"
myres.Open strSQL, conn, adOpenStatic
myres.Open strSQL, conn, adOpenStatic
If myres.RecordCount > 0 Then
mysheet.Cells.CopyFromRecordset myres
mybook.SaveAs "c:\文件名.xls" '保存文件
End If
mybook.Close
myexcel.Quit
Set mybook = Nothing
Set myexcel = Nothing
end sub
Public Function QueryToExcel(ByVal strOpen As String)
'*********************************************************
'* 名称:ExporToExcel
'* 功能:导出数据到EXCEL
'* 用法:ExporToExcel(sql查询字符串)
'* 注:须在程序中引用'Microsoft Excel 9.0 Object Library'和ADO对象,机器必装Excel 2000
'*********************************************************
Dim Rs_Data As New ADODB.Recordset
Dim Irowcount As Long
Dim Icolcount As Long
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlQuery As Excel.QueryTable
On Error GoTo err:
With Rs_Data
If .State = adStateOpen Then
.Close
End If
.ActiveConnection = Adoconn
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Source = strOpen
.Open
End With
With Rs_Data
If .RecordCount < 1 Then
MsgBox ("没有记录!")
Exit Function
End If
'记录总数
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(Rs_Data, xlSheet.Range("a1")) '从第几行,第几列开始显示 update by cjs
With xlQuery
' .FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True End With
' xlQuery.FieldNames = True '显示字段名
xlQuery.Refresh
With xlSheet
.Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Name = "黑体"
'设标题为黑体字
.Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = True
'标题字体加粗
' .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous
'设表格边框样式
End With
With xlSheet.PageSetup
' .LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称:" ' & Gsmc
' .CenterHeader = "&""楷体_GB2312,常规""公司人员情况表&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10日 期:"
' .RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10单位:"
'' .LeftFooter = "&""楷体_GB2312,常规""&10制表人:"
' .CenterFooter = "&""楷体_GB2312,常规""&10制表日期:"
' .RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
End With
xlApp.Application.Visible = True
Set xlApp = Nothing '"交还控制给Excel
Set xlBook = Nothing
Set xlSheet = Nothing
Exit Function
err:
MsgBox err.DescriptionEnd FunctionPrivate Sub Class_Initialize()
'类初始化时建立与程序同样的数据库连接
Dim StrConnect As String
StrConnect = "driver={sql server};server=127.0.0.1;uid=SA;pwd=;database=test"
Adoconn.ConnectionString = StrConnect
Adoconn.Open
End SubPrivate Sub Class_Terminate()
'类释放时关闭数据库连接
On Error GoTo err:
If Adoconn.State = 1 Then
Adoconn.Close
Set Adoconn = Nothing
End If
Exit Sub
err:
End Sub
'添加查询语句,导入EXCEL数据
的格式是怎么样的啊?
http://www.microsoft.com/china/community/Column/31.mspx
http://www.microsoft.com/china/community/Column/32.mspx
更多的导出excel信息,请参考:
http://support.microsoft.com/default.aspx?kbid=247412
http://support.microsoft.com/default.aspx?scid=kb;EN-US;146406
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q295646
http://support.microsoft.com/default.aspx?scid=kb;EN-US;246335