我正在尝试读取DBF文件并将其内容导入到excel文件，同时保持数据的格式相同。
我找到了执行此操作的在线代码，并为我的表对其进行了修改。代码如下：
显式选项
子ReadDBF（）
'-------------------------------------------------------------------------------
'This macro opens the Sample.dbf database, runs an SQL query (filtering all
'the country data from Canada) and copies the results back in the Excel sheet.
'The code uses late binding, so no reference to external library is required.
'Written by: Christos Samaras
'Date: 25/09/2013
'e-mail: xristos.samaras@gmail.com
'site: https://myengineeringworld.net/////
'-------------------------------------------------------------------------------
'Declaring the necessary variables.
Dim con As Object
Dim rs As Object
Dim DBFFolder As String
Dim FileName As String
Dim sql As String
Dim myValues() As String
Dim i As Integer
Dim j As Integer
Dim test As String
'Disable screen flickering.
Application.ScreenUpdating = False
'Specify the folder and the filename of the dbf file. If you use full path like
'C：UsersChristosDesktop注意不要忘记最后的反斜杠。 DBFFolder = ThisWorkbook.Path＆“” FileName =“ test.dbf”
On Error Resume Next
'Create the ADODB connection object.
Set con = CreateObject("ADODB.connection")
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Connection was not created!", vbCritical, "Connection error"
Exit Sub
End If
On Error GoTo 0
'Open the connection.
con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBFFolder & ";Extended Properties=dBASE IV;"
'Create the SQL statement to read the file. Filter all the data from Canada.
'Note that the filename is used instead of the table name.
'test = Left(FileName, (InStrRev(FileName, ".", -1, vbTextCompare) - 1))
sql = "SELECT * FROM " & Left(FileName, (InStrRev(FileName, ".", -1, vbTextCompare) - 1))
On Error Resume Next
'Create the ADODB recordset object.
Set rs = CreateObject("ADODB.recordset")
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Connection was not created!", vbCritical, "Connection error"
Exit Sub
End If
On Error GoTo 0
'Set thee cursor location.
rs.CursorLocation = 3 'adUseClient on early binding
rs.CursorType = 1 'adOpenKeyset on early binding
'Open the recordset.
rs.Open sql, con
'Redim the table that will contain the filtered data.
ReDim myValues(rs.RecordCount, 72)
'Loop through the recordset and pass the selected values to the array.
i = 1
If Not (rs.EOF And rs.BOF) Then
'Go to the first record.
rs.MoveFirst
Do Until rs.EOF = True
myValues(i, 1) = rs!fecha
myValues(i, 2) = rs!cia
myValues(i, 3) = rs!Update
myValues(i, 4) = rs!pol_num
myValues(i, 5) = rs!era_tiox
myValues(i, 6) = rs!era_endesa
myValues(i, 7) = rs!era_pop
myValues(i, 8) = rs!era_prej
myValues(i, 9) = rs!apendice
myValues(i, 10) = rs!oper
myValues(i, 11) = rs!State
myValues(i, 12) = rs!ajuste
myValues(i, 13) = rs!asegurado
myValues(i, 14) = rs!centro
myValues(i, 15) = rs!grupo
myValues(i, 16) = rs!birth_day
myValues(i, 17) = rs!birth_mth
myValues(i, 18) = rs!birth_yr
myValues(i, 19) = rs!sex
myValues(i, 20) = rs!motivobaja
myValues(i, 21) = rs!rider_type
myValues(i, 22) = rs!tranche
myValues(i, 23) = rs!pens_basic
myValues(i, 24) = rs!Formula
myValues(i, 25) = rs!mth_bas_te
myValues(i, 26) = rs!yr_bas_tec
myValues(i, 27) = rs!int_tecpas
myValues(i, 28) = rs!int_garpas
myValues(i, 29) = rs!issue_day
myValues(i, 30) = rs!issue_mth
myValues(i, 31) = rs!issue_yr
myValues(i, 32) = rs!mthintgapa
myValues(i, 33) = rs!mo_tab_pas
myValues(i, 34) = rs!mo_tab_act
myValues(i, 35) = rs!initial_mt
myValues(i, 36) = rs!initial_yr
myValues(i, 37) = rs!type_inc
myValues(i, 38) = rs!perc_inc
myValues(i, 39) = rs!type_defer
myValues(i, 40) = rs!deferment
myValues(i, 41) = rs!type_temp
myValues(i, 42) = rs!temp
myValues(i, 43) = rs!age_maxtra
myValues(i, 44) = rs!type_pay
myValues(i, 45) = rs!age_maxchi
myValues(i, 46) = rs!rate_pay
myValues(i, 47) = rs!days_pay
myValues(i, 48) = rs!days_payex
myValues(i, 49) = rs!mths_extra
myValues(i, 50) = rs!perc_extra
myValues(i, 51) = rs!exp_rate
myValues(i, 52) = rs!bth_day_2
myValues(i, 53) = rs!bth_mth_2
myValues(i, 54) = rs!bth_yr_2
myValues(i, 55) = rs!sex_bene
myValues(i, 56) = rs!nb
myValues(i, 57) = rs!fund_name
myValues(i, 58) = rs!pension
myValues(i, 59) = rs!Product
myValues(i, 60) = rs!Group
myValues(i, 61) = rs!ddfname
myValues(i, 62) = rs!mo_tab_mod
myValues(i, 63) = rs!retire_day
myValues(i, 64) = rs!retire_mth
myValues(i, 65) = rs!retire_yr
myValues(i, 66) = rs!recordno
myValues(i, 67) = rs!rva_orig
myValues(i, 68) = rs!col_tabact
myValues(i, 69) = rs!col_motab1
myValues(i, 70) = rs!col_motab2
myValues(i, 71) = rs!fechaaju
myValues(i, 72) = rs!f_jub
'Move to the next record.
rs.MoveNext
i = i + 1
Loop
Else
'Close the recordset and the connection.
rs.Close
con.Close
'Release the objects.
Set rs = Nothing
Set con = Nothing
'Enable the screen.
Application.ScreenUpdating = True
'In case of an empty recordset display an error.
MsgBox "There are no records in the recordset!", vbCritical, "No Records"
Exit Sub
End If
'Write the array in the sheet.
Sheet1.Activate
For i = 1 To UBound(myValues)
For j = 1 To 72
Cells(i + 1, j) = myValues(i, j)
Next j
Next i
'Close the recordset and the connection.
rs.Close
con.Close
'Release the objects.
Set rs = Nothing
Set con = Nothing
'Adjust the columns width.
Columns("A:BT").EntireColumn.AutoFit
'Enable the screen.
Application.ScreenUpdating = True
'Inform the user that the macro was executed successfully.
MsgBox "The values were read from recordset successfully!", vbInformation, "Done"
结束子
在运行此代码时，出现错误，提示“运行时错误：外部表未采用预期格式” 你能帮我这个忙吗？