(免安装1.0Demo)ExcelToTable(xls2dbf).rar (2.8 MB)

[此贴子已经被作者于2025-1-30 22:16编辑过]

程序代码：

* 选择 Excel 文件
FILENAME = GETFILE("XLS", "文件名", "确定", 0, "请选择 EXCEL 文件")
IF EMPTY(FILENAME)
   MESSAGEBOX("未选择（未找到需要的）EXCEL 文件", 64, "系统信息")
   RETURN
ENDIF

* 检查是否已打开同名表
IF USED(JUSTSTEM(FILENAME))
   USE IN SELECT(JUSTSTEM(FILENAME))
ENDIF

* 设置 DBF 文件名
DBFNAME = PUTFILE("保存为(&N):", JUSTSTEM(FILENAME) + ".DBF", "DBF")
IF EMPTY(DBFNAME)
   MESSAGEBOX("DBF 文件名不能为空", 64, "系统信息")
   RETURN
ENDIF

* 创建 Excel 对象
OEXCEL = CREATEOBJECT("EXCEL.APPLICATION")
IF TYPE("OEXCEL") <> "O" OR ISNULL(OEXCEL)
   MESSAGEBOX("无法创建 Excel 对象，请确保已安装 Microsoft Excel。", 16, "系统信息")
   RETURN
ENDIF

* 转换过程
WAIT "正在转换 " + FILENAME WINDOW TIMEOUT 0 NOWAIT AT SROWS() / 2, (SCOLS() - LEN("正在转换 " + FILENAME)) / 2

WITH OEXCEL
   .DISPLAYALERTS = .F.  && 关闭提示信息
   .VISIBLE = .F.        && 不显示 Excel 界面

   * 打开 Excel 文件
   TRY
      .WORKBOOKS.OPEN(FILENAME)
   CATCH
      MESSAGEBOX("无法打开文件：" + FILENAME, 16, "系统信息")
      .QUIT
      RELEASE OEXCEL
      WAIT CLEAR
      RETURN
   ENDTRY

   * 获取第一个工作表的数据范围
   TRY
      R = .SHEETS(1).USEDRANGE.ROWS.COUNT     && 有数据的行
      C = .SHEETS(1).USEDRANGE.COLUMNS.COUNT  && 有数据的列
   CATCH
      MESSAGEBOX("无法读取 Excel 文件数据，请检查文件格式。", 16, "系统信息")
      .WORKBOOKS.CLOSE
      .QUIT
      RELEASE OEXCEL
      WAIT CLEAR
      RETURN
   ENDTRY

   * 保存为 DBF 文件
   TRY
      .ACTIVEWORKBOOK.SAVEAS(DBFNAME, 11)  && 保存为 DBF4 格式
   CATCH
      MESSAGEBOX("保存 DBF 文件失败，请检查路径和权限。", 16, "系统信息")
      .WORKBOOKS.CLOSE
      .QUIT
      RELEASE OEXCEL
      WAIT CLEAR
      RETURN
   ENDTRY

   * 关闭 Excel
   .WORKBOOKS.CLOSE
   .QUIT
ENDWITH

* 释放资源
RELEASE OEXCEL
WAIT CLEAR

* 提示完成
MESSAGEBOX(DBFNAME + " 转换完毕", 64, "系统信息")