＋设为首页 ＋添加到收藏夹
关于向EXCEL导出数据的一些讨论:
用EXCEL打报表好象比较时髦的样子,天天看到有人问向Excel导数据的问题,于是想整理一下贴出来,如果谁有好的方法,补上Please!反正也没有什么版不版权的,帖上就是让大家看的吗!当然方法越多越好了.
1.准备工作 建立EXCEL,录宏…
还是用代码说事吧.
Private xlSheet As Excel.Worksheet
Private xlApp As Excel.Application
Private xlBook As Excel.Workbook
Private sub OpenExcelFile()
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(App.Path & "\rpt\daily.xls")
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Activate
xlApp.Visible = False
‘可以打开一个已经有格式的EXCEL文件做模板,也可以做一个新的什么都在代码中写进去,不过画表头是比较累的.
If Dir (App.Path & "\Rpt\tmp\Daily.xls") <> "" Then
Kill App.Path & "\Rpt\tmp\Daily.xls"
End If
……………..
‘Export data
xlBook.SaveAs App.Path & "\rpt\tmp\daily.xls"
xlBook.Close
‘不知道什么人说的要save as 一下,然后在打开,好象可以减少一些错误…不求甚解了,就这么用吧.
xlApp.Quit
Set xlApp = Nothing
‘这个地方比较的有趣,偶尔会出现quit不了的excel task.谁有什么办法?只要不是找句柄去关它就行呀!
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(App.Path & "\rpt\tmp\daily.xls")
Set xlSheet = xlBook.Worksheets(1)
‘save as 完了,还是要打开看看的…
End Sub
好,再说说录宏…
打开一个新的excel 文件,在工具-宏-录制新的宏..
于是我们建立了一个宏,它可以把你在EXCEL中所有的行为都记录下来..什么设置打印机,字体…也就是说你需要做什么,就录下来.
然后我们编辑录好的宏,把代码拷贝下来,改改,就可以粘贴在VB中使用了…
2.导出:
记得最早接触这个东西,我是这样用的.
While Not arsFee.EOF
I = I + 1
xlsheet.Cells(I, 1) = arsFee.Fields(10).Value
xlsheet.Cells(I, 2) = arsFee.Fields(11).Value
xlsheet.Cells(I, 3) = arsFee.Fields(2).Value
xlsheet.Cells(I, 4) = arsFee.Fields(3).Value
xlsheet.Cells(I, 5) = arsFee.Fields(13).Value
xlsheet.Cells(I, 6) = arsFee.Fields(5).Value
xlsheet.Cells(I, 7) = arsFee.Fields(4).Value
arsFee.MoveNext
Wend
虽然结果是正确的,不过效率太低了..慢!
于是乎苦思苦想,发现可以把数据做成数组,然后在直接粘过来….速度快了,不过好象不是很…那个,就不说细节了…
于是就更加苦思苦想---答案是(忘了谁告诉的了),不要向excel中写数据,而是让excel去读数据…
方法1: CopyFromRecordset recordset
xlSheet.Range("A1").CopyFromRecordset ARS
速度很快!也简单.
不过TNND不支持ADO 和 Excel97.还是苦呀!
不过Office 2000肯定是没有问题了.要是excel97 的话,就DAO吧!
方法2(也忘了谁告诉我的了): 用Excel 的 “获取外部数据”，单击“新建查询”；于是就生成了以下的宏:
Sheets(activesheetname).Activate
Cells.Select
Selection.Clear
Range("a1").Select
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;CollatingSequence=ASCII;DBQ=C:\T\palm1;DefaultDir=
C:\T\palm1;Deleted=1;
Driver={Microsoft dBase Driver (*.dbf)};
DriverId=533;FIL"), Array( "=dBase III;
ImplicitCommitSync=Yes;
MaxBufferSize=512;
MaxScanRows= 8;
PageTimeout=600;
SafeTransactions=0;
Statistics=0;
Threads=3;Use" ), Array("rCommitSync=Yes;")),
Destination:=Range("A1"))
以上是对什么base的导出…
那么对SQL 如何做呢,如何才能通用一些呢?
(又有人说了, 谁?忘了)
可以先做一个查询SQL文件,然后调用就是了… 如下:
StrFile = "XLODBC" & Chr(13) & Chr(10) & _
"1" & Chr(13) & Chr(10) & _
"DRIVER=SQL Server;SERVER=" & SOpen.ServerIp & ";UID=sa;PWD=" & SOpen.Pwd & ";APP=;DATABASE=" & SOpen.Database & ";" & Chr(13) & Chr(10) & _
"select a,b,c from Table1 where a like ‘test%’ order by No"
[一定要注意文件形成的格式.]
If Dir(App.Path & "\query.txt") <> "" Then Kill App.Path & "\query.txt"
Open App.Path & "\query.txt" For Binary As #1
Put #1, , StrFile
Close #1
[形成了文件]
Call MarcoQuery
Sub MarcoQuery()
On Error GoToError01
xlSheet.Range("A1").Select
With xlSheet.QueryTables.Add(Connection:= _
"FINDER;" & App.Path & "\query.txt", Destination:=xlSheet.Range( _
"A1"))
.FieldNames = False
.RefreshStyle = xlInsertDeleteCells
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = False
.HasAutoFormat = False
.BackgroundQuery = False
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SavePassword = True
.SaveData = True
End With
Exit Sub
Error01:
MsgBox Err.Description
End Sub
哈,好象可以了呀!
欢迎转载,随便添加内容了!
SQL这样做:
Dim cn As New ADODB.Connection
Dim mrs As ADODB.Recordset
Dim connstr As String
Dim ex As New Excel.Application
Dim exwbook As Excel.Workbook
Dim exsheet As Excel.Worksheet
Dim xlQuery As Excel.QueryTable
connstr = "YourConnectionString "
cn.Open connstr
Set mrs = New ADODB.Recordset
Set ex = CreateObject("Excel.Application")
Set exwbook = Nothing
Set exsheet = Nothing
Set exwbook = ex.Workbooks().Add
Set exsheet = exwbook.Worksheets("sheet1")
ex.Visible = True
Dim strOpen As String
strOpen = "SELECT * FROM table1"
mrs.CursorLocation = adUseClient
mrs.Open strOpen, cn, adOpenForwardOnly, adLockReadOnly
Set xlQuery = exsheet.QueryTables.Add(mrs, exsheet.Range("A1"))
xlQuery.FieldNames = True 显示字段名
xlQuery.Refresh
