代碼如下:
'************************************************
'** 函數(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