vfp dbf导出excel

CLOSE DATABASES ALL
SET DATE YMD
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