Question

我有一个文件夹＆＃34; test＆＃34;包含几个dbf文件。我希望vba在excel文件中打开它们并以excel格式保存在另一个保存相同dbf文件名的文件夹中。

我在网上发现了这个代码，我正在尝试将此代码用于我的需求，但它不会起作用。错误讯息：

＆＃34;未定义的功能子＆＃34;

...请仔细研究。

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-Files测试它）：

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"

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

1 个答案: