这是一个初版脚本。我使用“公式”技巧强制 Excel 不进行数据转换。因此，这对于查看文件来说没问题，但需要更多工作才能达到完美。我将尽快尝试寻找更多时间。要使用该脚本，请将其放置在您的桌面上。然后，将 DBF 文件拖放到脚本上，并将其拖放到脚本上。然后，脚本将打开 Excel，并将 DBF 文件中的数据加载到新工作簿中的新电子表格中。

如果您想了解更多关于拖放脚本、脚本宏以及成为 Excel 大神的信息，请参阅我的书“新手入门 - 如何成为 Excel 大神，无需真正尝试”。本页底部有一个链接，可以获取更多信息。

' Here is the script,I'll do a DBF write version soon
Option Explicit 
Dim inputFile,path,fileName,tableName
Dim rs,fieldVals,i,myExcel,myWorkBook,mySheet,row,column
Const adOpenDynamic=2
Const adLockPessimistic=2
Const adCmdTable=2
Const adOpenForwardOnly=0

inputFile=WScript.Arguments.Item(0)
path=Split(inputFile,"\")
fileName=path(Ubound(path))
path(Ubound(path))=""
path=Join(path,"\")
tableName=Left(fileName,Len(fileName)-4)
Dim dBConn
Set dBConn=OpenDBFConn(path)

Set rs=CreateObject("ADODB.Recordset")
rs.Open tableName, dbConn, adOpenForwardOnly, _
        adLockPessimistic, adCmdTable

Set myExcel=CreateObject("Excel.Application")
Set myWorkBook=myExcel.Workbooks.Add()
Set mySheet=myWorkBook.Sheets(1)
myExcel.Visible=TRUE

rs.MoveFirst
Dim field
row=1
column=1
For Each field In rs.Fields
    mySheet.Cells(row,column).Value=field.Name
    WScript.Echo field.type
    column=column+1
Next
row=2

Redim fieldVals(rs.Fields.Count - 1)

While Not rs.EOF
    column=0
    For Each field In rs.Fields
        fieldVals(column)="=""" & _
                          field.Value & """"
        column=column+1
    Next
    mySheet.Range(mySheet.Cells(row,1), _
            mySheet.Cells(row,column)).Formula=fieldVals
    row=row+1
    rs.MoveNext
Wend
rs.Close
WScript.Echo "Loading Finished"

Function OpenDBFConn(Path)
    Dim Conn
    Set Conn = CreateObject("ADODB.Connection")
    Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                   "Data Source=" & Path & ";" & _
                   "Extended Properties=""DBASE IV;"";" 
    Set OpenDBFConn = Conn
End Function

将 Excel 文件转换为 DBF 格式

同样，看来 Excel 2007 已经不再支持 DBF 格式。这里是一个简单的脚本，用于将 Excel (.xls, .xlsx, .csv 等) 文件转换为 DBF 格式。

这离完美还差很远。这个实现最糟糕的地方在于它只将数据存储为 VARCHAR(64)。我可能会很快尝试创建一个更友好的类型版本。

该脚本使用了我的书“新手入门 - 如何成为 Excel 大神，无需真正尝试”中解释的拖放脚本技术。如果您想了解更多关于如何通过 Excel 接管世界的信息，请查看我的博客页面底部的书籍链接 ;)

该脚本将为工作簿中的每个电子表格生成一个 xxxx_n.dbf 文件，其中 xxxx 是工作簿文件的名称，n 是电子表格的索引（1、2 等）。该脚本的工作方式是使用 ADODB 创建一个具有 'Create Table' 的 DBF 表，然后打开一个指向该表的动态记录集（使用 DBF 提供程序创建表会创建一个 DBF 文件）。然后，对电子表格中的每个非空行调用记录集上的 AddNew。我使用数组访问电子表格来加快速度。

Option Explicit
Dim inputFile, path, fileName, tableName, createTable
inputFile=WScript.Arguments.Item(0)
path=Split(inputFile,"\")
fileName=path(Ubound(path))
path(Ubound(path))=""
path=Join(path,"\")
Dim dBConn
Set dBConn=OpenDBFConn(path)

' Get the name of the new table in a way will cope with .xls .xlsz etc
tableName=Split(fileName,".")
tableName(Ubound(tableName))=""
tableName=Join(tableName,".")
tableName=Left(tableName,Len(tableName)-1)

'  Open Excel and scan each spreadsheet
Dim myExcel,myWorkbook, mySheet,nColumns,column
Dim fields,row,scan,thisTableName,sheetCount
Dim createString,i

Set myExcel=CreateObject("Excel.Application")
myExcel.Visible=TRUE
Set myWorkbook=myExcel.Workbooks.Open(inputFile)

sheetCount=1
For Each mySheet In myWorkbook.Sheets
    ' Get number of fields from column headers
    scan=mySheet.Rows(1).Value
    For nColumns=1 To UBound(scan,2)
        If IsEmpty(scan(1,nColumns)) Then Exit For
    Next    
    nColumns=nColumns-1
    If nColumns >0 Then
        thisTableName=tableName & "_" & sheetCount
        createString="CREATE TABLE "
        createString=createString & thisTableName & " ("
        For i=1 to nColumns
            createString = createString & "[" & _
                           Replace(scan(1,i)," ","_") & _
                           "] VARCHAR(64) "
            If Not i=nColumns Then
                createString=createString & ", "
        Next
        createString=createString & " )"
        On Error Resume Next
        dbConn.Execute "Drop Table " & thisTableName
        On Error Goto 0
        WScript.Echo createString
        dBConn.Execute createString
        
        ' Now we have the table, let us write to it
        Dim rs,fieldPos,fieldVals
        Redim fieldPos(nColumns-1)
        Redim fieldVals(nColumns-1)
        For i=0 to nColumns-1
           fieldPos(i)=i
        Next
        Set rs=CreateObject("ADODB.Recordset")
        Const adOpenDynamic=2
        Const adLockPessimistic=2
        Const adCmdTable=2

        rs.Open thisTableName, dbConn, adOpenDynamic, _
                adLockPessimistic, adCmdTable

        For row=2 to 1048576
            scan=mySheet.Rows(row).Value
            For i=1 to nColumns
                If Not IsEmpty(scan(1,i)) Then Exit For
            Next
            ' Blank row found
            If i > nColumns Then Exit For
            For i=0 to nColumns-1
                fieldVals(i)=scan(1,i+1)
            Next
            rs.AddNew fieldPos,fieldVals
        Next

        rs.Close

    End If
    sheetCount=sheetCount+1
Next

Function OpenDBFConn(Path)
  Dim Conn
  Set Conn = CreateObject("ADODB.Connection")
  Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                   "Data Source=" & Path & ";" & _
                   "Extended Properties=""DBASE IV;"";" 
  Set OpenDBFConn = Conn
End Function

新手入门 - 如何成为 Excel 大神，无需真正尝试