打开文件夹中的所有dbf文件并将它们另存为excel到另一个文件夹中

Question

我有一个包含多个dbf文件的“test”文件夹。我想要vba在excel文件中打开它们并将它们（以excel格式）保存在保存相同dbf文件名的另一个文件夹中。

我在网上发现了这段代码，并试图使用这段代码来满足我的需求，但它不起作用。错误信息：

“的功能子没有定义”

...请调查一下。

Sub test() 

Dim YourDirectory As String 
Dim YourFileType As String 
Dim LoadDirFileList As Variant 
Dim ActiveFile As String 
Dim FileCounter As Integer 
Dim NewWb As Workbook 

YourDirectory = "c:\Users\navin\Desktop\test\" 
YourFileType = "dbf" 

LoadDirFileList = GetFileList(YourDirectory) 
If IsArray(LoadDirFileList) = False Then 
    MsgBox "No files found" 
    Exit Sub 
Else 
    ' Loop around each file in your directory 
    For FileCounter = LBound(LoadDirFileList) To UBound(LoadDirFileList) 
     ActiveFile = LoadDirFileList(FileCounter) 
     Debug.Print ActiveFile 
     If Right(ActiveFile, 3) = YourFileType Then 
      Set NewWb = Application.Workbooks.Open(YourDirectory & ActiveFile) 
      Call YourMacro(NewWb) 
      NewWb.SaveAs YourDirectory & Left(ActiveFile, Len(ActiveFile) - 4) & ".xlsx" 
      NewWb.Saved = True 
      NewWb.Close 
      Set NewWb = Nothing 
     End If 
    Next FileCounter 
End If 
End Sub 

Answer 1

你缺少的功能GetFileList和YourMacro。快速搜索带我到这个网站（我认为你从那里复制）。 http://www.ozgrid.com/forum/printthread.php?t=56393

有缺失的功能。还复制这两个在你的模件，使其运行（我用PDF的文件测试吧）：

Function GetFileList(FileSpec As String) As Variant 
' Author : Carl Mackinder (From JWalk) 
' Last Update : 25/05/06 
' Returns an array of filenames that match FileSpec 
' If no matching files are found, it returns False 

Dim FileArray() As Variant 
Dim FileCount As Integer 
Dim FileName As String 

On Error GoTo NoFilesFound 

FileCount = 0 
FileName = Dir(FileSpec) 
If FileName = "" Then GoTo NoFilesFound 

' Loop until no more matching files are found 
Do While FileName <> "" 
     FileCount = FileCount + 1 
     ReDim Preserve FileArray(1 To FileCount) 
     FileArray(FileCount) = FileName 
     FileName = Dir() 
Loop 
    GetFileList = FileArray 
Exit Function 

NoFilesFound: 
    GetFileList = False 
End Function 

Sub YourMacro(Wb As Workbook) 
Dim ws As Worksheet 
Set ws = Wb.Worksheets(1) 
ws.Range("A6").Value = "=((+A2*$CN2)+(A3*$CN3)+(A4*$CN4)+(A5*$CN5))/SUM($CN2:$CN5)" 
ws.Range("A6").Copy ws.Range("B6:CM6") 
ws.Range("CO6").Value = "=CO2" 
End Sub 

要保存在不同的目录下的文件：

Dim SaveDirectory As String 
SaveDirectory = "c:\Users\navin\Desktop\test\converted to excel" 

替换该行

NewWb.SaveAs YourDirectory & Left(ActiveFile, Len(ActiveFile) - 4) & ".xlsx" 

与此

NewWb.SaveAs SaveDirectory & Left(ActiveFile, Len(ActiveFile) - 4) & ".xlsx"