关于导出EXCEL问题，继续请教吹版
吹版好，根据您在我另一个关于导出EXCEL帖子中提供的程序，做了个导出EXCEL函数，请指正（1）可在一个EXCEL中导出不同sheet
（2）加上了表头行
（3）测试结果：sheet1-7042条，sheet2-473765条，用时277秒
导出的数据有个问题，查了网上没找到相应的方法：导出的字符型字段字符数是按字段宽度在有效字符后面加了空格，如：字符字段长度10，内容为：123，导出的结果是：123<7个空格>，有什么方法统一将字符后面的空格（或非打印字符）去掉？
先行谢过！！！
程序代码：
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
[此贴子已经被作者于2021-9-20 20:08编辑过]
