Question

我编写了以下代码，该代码应该打开指定的Windows目录，然后逐个处理该位置的所有Excel（.xls）文件。更具体地说，代码将打开一个excel文件，获取工作表的名称并将该名称/值放入该工作表的单元格A1中，然后保存并关闭该文件。然后它将移动到目录中的下一个Excel文件。

我面临的问题是，在执行代码时，我得到以下编译错误：“Sub or Function not defined”。我只是无法弄清楚导致此错误的原因。

请参阅下面的代码：

Sub UseSheetName()
    selectedfolder = GetFolder("c:\")
    Call updateAllWorkbooks(selectedfolder)
End Sub

Function GetFolder(strPath As String) As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath

        If .Show <> -1 Then GoTo NextCode
            sItem = .SelectedItems(1)
    End With

NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Function updateAllWorkbooks(workDir)
    Dim fso, f, fc, fl
    Dim newName As String, appStr As String, SubDir As String

    On Error GoTo updateAllWorkbooks_Error

    SubDir = workDir & "\" & "ConvertedFiles"
    If Not fExists(SubDir) Then
        MkDir SubDir
    End If

    Application.ScreenUpdating = False

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder(workDir)
    Set fc = f.Files

    For Each fl In fc
        If Right(fl, 4) = ".xls" Then
            Application.DisplayAlerts = False
            Workbooks.Open Filename:=fl
            ActiveSheet.[a1] = ActiveSheet.Name
            ActiveWorkbook.Save
            ActiveWorkbook.Close
            Application.DisplayAlerts = True
        End If
    Next

    Application.ScreenUpdating = True

    On Error GoTo 0
    Exit Function

updateAllWorkbooks_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure updateAllWorkbooks of Module Module2"
End Function

Answer 1

如果这是您的所有代码，那么您没有定义为fExists的函数。因此，If Not fExists(SubDir) Then行会失败，因为函数fExists未定义。

VBA脚本错误：＆＃34; Sub或Function未定义＆＃34;

1 个答案: