吹版好,根据您上面提供的程序,做了个导出EXCEL函数,请指正
(1)可在一个EXCEL中导出不同sheet
(2)加上了表头行
(3)测试结果:sheet1-7042条,sheet2-473765条,用时277秒
FUNCTION Dbf2excel(cExcelfilename,cDbfname,cSheetname,cFields,cFilter)
********************************************************
* cExcelfilename:C,带完整路径的EXCEL文件全名,abc.xlsx
* cDbfname: C,数据文件名
* cSheetname: C,工作表名字,可空
* cFields: C,"class 班级,name 姓名,math 数学"
* cFilter: C,数据过滤条件,可空
********************************************************
cFields = EVL(cFields,'*')
cSheetname = EVL(cSheetname,'')
cFilter = EVL(cFilter,'1=1')
LOCAL sc,arr[1],vbsCode,aFieldInfo[1],nStep,xnewfile,xtmpfile,i,xfile
xfile = cDbfname
sc = CREATEOBJECT("ScriptControl")
sc.Language = "VBScript"
TEXT TO vbsCode TEXTMERGE NOSHOW PRETEXT 7
dim oExcel,oRange, nRows, nCols, nCol,cExcelname
set oExcel = CREATEOBJECT("Excel.Application")
function Open(cExcelname,cSheetname,nNew)
if nNew=0 then
' 新建
oExcel.Workbooks.Add
oExcel.ActiveWorkbook.saveas cExcelname
else
'已有
oExcel.Workbooks.Open(cExcelname)
oExcel.ActiveWorkbook.Worksheets.Add
end if
if cSheetname<>"" then
oExcel.Activesheet.name = cSheetname
end if
end function
function SetFormat(aFieldInfo, nRows)
for nCol=1 to UBound(aFieldInfo,1)
oExcel.Range(oExcel.Cells(1,nCol),oExcel.Cells(nRows,nCol)).Select
oExcel.Selection.NumberFormatLocal = aFieldInfo(nCol,8)
next
end function
function Append(vfpArray, nRow)
nRows = UBound(vfpArray,1)
nCols = UBound(vfpArray,2)
oExcel.Range(oExcel.Cells(nRow,1),oExcel.Cells(nRow+nRows-1,nCols)).Value = vfpArray
end function
function Close(nRows, nCols)
oExcel.Range(oExcel.Cells(1,1),oExcel.Cells(nRows,nCols)).Columns.AutoFit
oExcel.Cells(1,1).select
oExcel.ActiveWorkbook.save
oExcel.quit
end function
function Show(nRows, nCols)
oExcel.Range(oExcel.Cells(1,1),oExcel.Cells(nRows,nCols)).Columns.AutoFit
oExcel.Visible = 1
end function
ENDTEXT
sc.AddCode(vbsCode)
* 是否新建EXCEL文件
xnewfile = IIF(file(cExcelfilename),1,0)
sc.Run("Open", cExcelfilename,cSheetname,xnewfile)
* 表头数组
xtmpfile = SYS(2015)
SELECT &cFields FROM &xfile WHERE &cFilter INTO CURSOR &xtmpfile READWRITE
DIMENSION arr[1,fcount(xtmpfile)]
* 字段类型
SELECT &xtmpfile
AFIELDS(aFieldInfo)
FOR i=1 TO ALEN(aFieldInfo,1)
arr[1,i] = aFieldInfo[i,1]
aFieldInfo[i,8] = ICASE(;
&& 数据格式
aFieldInfo[i,2]=="I", '##0;[=0]""',;
&& 整数格式
INLIST(aFieldInfo[i,2],"B","N","F"), '#,##0.'+REPLICATE("0",aFieldInfo[i,4])+';[=0]""',; && 小数格式
INLIST(aFieldInfo[i,2],"C","V","W","M"), '@',;
&& 文本格式
aFieldInfo[i,2]=="D", 'yyyy-m-d',;
&& 日期格式
aFieldInfo[i,2]=="T", 'yyyy-m-d hh:mm:ss',;
&& 日期时间格式
'G/通用格式')
ENDFOR
* 插入表头
sc.Run("Append", @arr, 1)
* 各列格式
sc.Run("SetFormat", @aFieldInfo, RECCOUNT(xtmpfile)+1)
* 表体
nStep = 10000
FOR i=1 TO RECCOUNT(xtmpfile) STEP nStep
SELECT * FROM &xtmpfile WHERE BETWEEN(RECNO(),i,i+nStep-1) INTO ARRAY arr
sc.Run("Append", @arr, i+1)
ENDFOR
sc.Run("Close",RECCOUNT(xtmpfile),FCOUNT(xtmpfile))
*sc.Run("Show",RECCOUNT(xfile),FCOUNT(xfile))
* 如果需要当时查看EXCEL表,可执行上面的语句
RELEASE sc
RETURN