代碼如下:

'************************************************

'** 函數(shù)名稱: exporttemplettoexcel

'** 函數(shù)功能: 將記錄集輸出到 excel 模板

'** 參數(shù)說明:

'** strexcelfile 要保存的 excel 文件

'** strsql 查詢語句，就是要導(dǎo)出哪些內(nèi)容

'** strsheetname 工作表名稱

'** adoconn 已經(jīng)打開的數(shù)據(jù)庫連接

'** 函數(shù)返回:

'** boolean 類型

'** true 成功導(dǎo)出模板

'** false 失敗

'** 參考實例:

'** call exporttemplettoexcel(c:\\text.xls,查詢語句,工作表1,adoconn)

'************************************************

private function exporttemplettoexcel(byval strexcelfile as string, _

byval strsql as string, _

byval strsheetname as string, _

byval adoconn as object) as boolean

dim adort as object

dim lngrecordcount as long ' 記錄數(shù)

dim intfieldcount as integer ' 字段數(shù)

dim strfields as string ' 所有字段名

dim i as integer

dim exlapplication as object ' excel 實例

dim exlbook as object ' excel 工作區(qū)

dim exlsheet as object ' excel 當(dāng)前要操作的工作表

on error goto localerr

me.mousepointer = vbhourglass

'// 創(chuàng)建 ado 記錄集對象

set adort = createobject(adodb.recordset)

with adort

.activeconnection = adoconn

.cursorlocation = 3 'aduseclient

.cursortype = 3 'adopenstatic

.locktype = 1 'adlockreadonly

.source = strsql

.open

if .eof and .bof then

exporttemplettoexcel = false

else

'// 取得記錄總數(shù)，+ 1 是表示還有一行字段名名稱信息

lngrecordcount = .recordcount + 1

intfieldcount = .fields.count - 1

for i = 0 to intfieldcount

'// 生成字段名信息（vbtab 在 excel 里表示每個單元格之間的間隔）

strfields = strfields & .fields(i).name & vbtab

next

'// 去掉最后一個 vbtab 制表符

strfields = left$(strfields, len(strfields) - len(vbtab))

'// 創(chuàng)建excel實例

set exlapplication = createobject(excel.application)

'// 增加一個工作區(qū)

set exlbook = exlapplication.workbooks.add

'// 設(shè)置當(dāng)前工作區(qū)為第一個工作表（默認(rèn)會有3個）

set exlsheet = exlbook.worksheets(1)

'// 將第一個工作表改成指定的名稱

exlsheet.name = strsheetname

'// 清除“剪切板”

clipboard.clear

'// 將字段名稱復(fù)制到“剪切板”

clipboard.settext strfields

'// 選中a1單元格

exlsheet.range(a1).select

'// 粘貼字段名稱

exlsheet.paste

'// 從a2開始復(fù)制記錄集

exlsheet.range(a2).copyfromrecordset adort

'// 增加一個命名范圍，作用是在導(dǎo)入時所需的范圍

exlapplication.names.add strsheetname, = & strsheetname & !$a$1:$ & _

ugetcolname(intfieldcount + 1) & $ & lngrecordcount

'// 保存 excel 文件

exlbook.saveas strexcelfile

'// 退出 excel 實例

exlapplication.quit

exporttemplettoexcel = true

end if

'adstateopen = 1

if .state = 1 then

.close

end if

end with

localerr:

'*********************************************

'** 釋放所有對象

'*********************************************

set exlsheet = nothing

set exlbook = nothing

set exlapplication = nothing

set adort = nothing

'*********************************************

if err.number <> 0 then

err.clear

end if

me.mousepointer = vbdefault

end function

'// 取得列名

private function ugetcolname(byval intnum as integer) as string

dim strcolnames as string

dim strreturn as string

'// 通常字段數(shù)不會太多，所以到 26*3 目前已經(jīng)夠了。

strcolnames = a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z, & _

aa,ab,ac,ad,ae,af,ag,ah,ai,aj,ak,al,am,an,ao,ap,aq,ar,as,at,au,av,aw,ax,ay,az, & _

ba,bb,bc,bd,be,bf,bg,bh,bi,bj,bk,bl,bm,bn,bo,bp,bq,br,bs,bt,bu,bv,bw,bx,by,bz

strreturn = split(strcolnames, ,)(intnum - 1)

ugetcolname = strreturn

end function