&& Dbf2Excel.PRG && 记得要安装Excel啊,否则不好用 CLOSE DATABASES ALL SET DATE ANSI SET CENTURY ON cDbfFile = GETFILE("dbf") IF EMPTY(cDbfFile) RETURN ENDIF USE (cDbfFile) ALIAS FoxTable IN 0 IF NOT USED("FoxTable") =MESSAGEBOX("打开表失败,程序将中止!", 16, "Error") RETURN ENDIF cExcelFile = PUTFILE("保存为(&N):",JUSTSTEM(cDbfFile)+".xls","xls") IF EMPTY(cExcelFile) CLOSE DATABASES ALL RETURN ENDIF SELECT FoxTable oExcelSheet = GETOBJECT("","Excel.Sheet") && 产生Excel对象 IF NOT TYPE("oExcelSheet") = "O" =MESSAGEBOX("Excel对象创建失败,程序将中止!", 16, "Error") RETURN ENDIF oExcelApp = oExcelSheet.Application oExcelApp.Workbooks.Add() oExcelApp.ActiveWindow.WindowState=2 oSheet = oExcelApp.ActiveSheet nFldCount = AFIELDS(aFldList, "FoxTable") FOR i = 1 TO nFldCount oSheet.Cells(1,i).Value = aFldList[i, 1] ENDFOR cRecc = STR(RECCOUNT("FoxTable")) SCAN WAIT WINDOW ALLTRIM(STR(RECNO())) + "/" + cRecc NOWAIT FOR i = 1 TO nFldCount vValue = .NULL. IF AT(aFldList[i, 2], "CDLMNFIBYT") = 0 LOOP ENDIF cFldName = aFldList[i, 1] vValue = EVALUATE(cFldName) DO CASE CASE aFldList[i, 2] = "C" && 字符/字符串 vValue = TRIM(vValue) CASE aFldList[i, 2] = "D" && 日期 vValue = DTOC(vValue) CASE aFldList[i, 2] = "T" && 日期时间 vValue = TTOC(vValue) CASE INLIST(aFldList[i, 2], "N", "F", "I", "B", "Y") && 数值 CASE aFldList[i, 2] = "L" && 逻辑 CASE aFldList[i, 2] = "M" && 备注型 OTHERWISE vValue = .NULL. ENDCASE IF VARTYPE(vValue) = "C" AND EMPTY(vValue) LOOP ENDIF IF NOT ISNULL(vValue) oSheet.Cells(RECNO("FoxTable")+1, i).Value = vValue ENDIF ENDFOR ENDSCAN cChrStr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" FOR i = 1 TO nFldCount cColumn = SUBSTR(cChrStr, INT((i-1)/26), 1) + SUBSTR(cChrStr, IIF(MOD(i, 26)= 0, 26, MOD(i, 26)) , 1) oSheet.Columns(cColumn + ":" + cColumn).ColumnWidth = 12 IF aFldList[i, 2] = "M" oSheet.Columns(cColumn + ":" + cColumn).WrapText = .F. ENDIF ENDFOR oExcelApp.ActiveWorkbook.SaveAs(cExcelFile) oExcelApp.ActiveWorkbook.Close(.F.) oExcelApp.ActiveWorkbook.Close(.F.) oExcelApp.Quit oExcelSheet = .NULL. oExcelApp = .NULL. WAIT CLEAR =MESSAGEBOX("转换完毕!", 64, "OK") CLOSE DATABASES ALL 程序是用VFP 8写的,记得好像在VFP 6中也试过,没有问题。只要能够执行完成,就会是正确的,行数只受你安装的Excel最大行数限制,至少大于65535行 我做这个程序就是因为转换数据时,有MEMO类型的字段,到了Excel里面就只有250个字节长了。 -------------------------------------------------------------- xlQuery=exlapp.ActiveSheet.QueryTables.Add("OLEDB;Provider=VFPOLEDB;Data Source="+ipath+";Mode=Share Deny None;Password='';Collating Sequence=MACHINE", exlapp.Range("A2"), "select * from table") 此种方法不支持包含MEMO超长的数据 --------------------------------------------------------------- 如果你的数据中都是普通的数值和字符串类型,直接用Excel打开表,然后“另存为”一个Excel就可以了,简单明了,不出错。
dbf 到 excel转换
最新推荐文章于 2022-10-09 08:00:00 发布