在文件夹中创建文件名数组 - Excel VBA

Posted

技术标签:

【中文标题】在文件夹中创建文件名数组 - Excel VBA【英文标题】：Create an array of file names in a folder - Excel VBA 【发布时间】：2018-06-01 18:37:21 【问题描述】：

我目前正在将 Application.GetOpenFilename 与 MultiSelect:=True 一起使用，以允许用户在文件夹中选择一个或多个文件，然后将所有文件中的数据导入工作表。如果选择了多个文件，则将每个文件中的数据附加到前一个文件中的数据，直到导入所有选定的文件。

我现在有一个实例，其中文本文件存储在特定文件夹的子文件夹中，子文件夹是根据订单号创建的。我现在尝试将父文件夹定义为变量，允许用户使用 Application.InputBox 输入子文件夹名称，然后自动从用户指定的子文件夹中的所有 .txt 文件中导入数据。我遇到了运行时错误“53”，找不到文件错误。我知道使用 GetOpenFilename 方法会创建一个文件名数组，我试图通过创建一个文件名数组来复制它，但我显然遗漏了一些东西。

我基本上是在尝试从以下内容导入所有 .txt 文件：

C:\AOI_DATA64\SPC_DataLog\IspnDetails\ 用户定义的子文件夹 \ *.txt

使用 Application.GetOpenFilename 工作的代码：

' Define that variables must be defined manually and will never be defined automatically
Option Explicit

    ' Hold specific variables in memory for use between sub-routines
    Public DDThreshold As Variant
    Public FileName As String
    Public FilePath As String
    Public OpenFileName As Variant
    Public OrderNum As Variant
    Public SaveWorkingDir As String
    Public SecondsElapsed As Double
    Public StartTime As Double
    Public TimeRemaining As Double

Sub Import_DataFile()

    ' Add an error handler
    ' On Error GoTo ErrorHandler

    ' Speed up this sub-routine by turning off screen updating and auto calculating until the end of the sub-routine
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Define variable names and types
    Dim DefaultOpenPath As String
    Dim SaveWorkingDir As String
    Dim OpenFileName As Variant
    Dim WholeFile As String
    Dim SplitArray
    Dim LineNumber As Integer
    Dim chkFormat1 As String
    Dim i As Long
    Dim n1 As Long
    Dim n2 As Long
    Dim fn As Integer
    Dim RawData As String
    Dim rngTarget As Range
    Dim rngFileList As Range
    Dim TargetRow As Long
    Dim FileListRow As Long
    Dim aLastRow As Long
    Dim bLastRow As Long
    Dim cLastRow As Long
    Dim dLastRow As Long
    Dim destCell As Range

    ' Set the default path to start at when importing a file
    'On Error Resume Next
    If Len(Dir("C:\AOI_DATA64\SPC_DataLog\IspnDetails", vbDirectory)) = 0 Then

        DefaultOpenPath = "C:\"

        Else

        DefaultOpenPath = "C:\AOI_DATA64\SPC_DataLog\IspnDetails\"

    End If

    ' When opening another file for processing, this section will save the previously opened file directory
    'On Error Resume Next
    If SaveWorkingDir = CurDir Then

    ChDrive SaveWorkingDir
    ChDir SaveWorkingDir

    Else

    ChDrive DefaultOpenPath
    ChDir DefaultOpenPath

    End If

    ' Select the source folder and point list file(s) to import into worksheet
    'On Error GoTo ErrorHandler
    OpenFileName = Application.GetOpenFilename( _
                   FileFilter:="AOI Inspection Results Data Files (*.txt), *.txt", _
                   Title:="Select a data file or files to import", _
                   MultiSelect:=True)


    ' Cancel the file import if the user exits the file import window or selects the Cancel button
    If Not IsArray(OpenFileName) Then

        MsgBox "" & vbNewLine & _
               "  No files were selected." & vbNewLine & _
               "" & vbNewLine & _
               "  Import AOI Inspection Results Data Files was aborted.", vbInformation, "File Import Cancelled"
        Exit Sub

    End If

    ' Clear contents and reset formatting of cells in all worksheets
    aLastRow = Worksheets("AOI Inspection Summary").Cells(Rows.Count, "B").End(xlDown).Row
    bLastRow = Worksheets("Raw Data").Cells(Rows.Count, "A").End(xlDown).Row
    cLastRow = Worksheets("Parsed Data").Cells(Rows.Count, "A").End(xlDown).Row

    Worksheets("AOI Inspection Summary").Range("E6:L14").ClearContents
        If aLastRow > 0 Then
        Worksheets("AOI Inspection Summary").Range("B24:L" & aLastRow).ClearContents
        Worksheets("AOI Inspection Summary").Range("B24:L" & aLastRow).ClearFormats
        End If

        If bLastRow > 0 Then
        Worksheets("Raw Data").Range("A1:Q" & bLastRow).ClearContents
        Worksheets("Raw Data").Range("A1:Q" & bLastRow).ClearFormats
        End If

        If cLastRow > 0 Then
        Worksheets("Parsed Data").Range("A1:Q" & cLastRow).ClearContents
        Worksheets("Parsed Data").Range("A1:Q" & cLastRow).ClearFormats
        End If

    Worksheets("AOI Inspection Summary").Range("E6:L9").NumberFormat = "@" 'Format cells to Text
    Worksheets("AOI Inspection Summary").Range("E10:L13").NumberFormat = "#,000" 'Format Cells to Number with commas
    Worksheets("AOI Inspection Summary").Range("E14:L14").NumberFormat = "0.00%" 'Format cells to Percent
    Worksheets("Raw Data").Columns("A:Z").EntireColumn.ColumnWidth = 8.09
    Worksheets("Parsed Data").Columns("A:Z").EntireColumn.ColumnWidth = 8.09

    ' Update "Defect Density Threshold" to default value unless user entered a new value
        If DDThreshold > 0 Then
        Worksheets("AOI Inspection Summary").Range("E10").Value = DDThreshold

        Else
        Worksheets("AOI Inspection Summary").Range("E10").Value = "3,000,000"

        End If

    ' Save the user selected open file directory as the default open file path while the worksheet is open
    SaveWorkingDir = CurDir

    ' Timer Start (calculate the length of time this sub-routine takes to complete after selecting file(s) to import)
    StartTime = Timer

    ' Check selected input file format for YesTech AOI Inspection Results format
    Const chkYesTech = "[StartIspn]"
    For n1 = LBound(OpenFileName) To UBound(OpenFileName)
        fn = FreeFile
        Open OpenFileName(n1) For Input As #fn
        Application.StatusBar = "Processing ... " & OpenFileName(n1)

            WholeFile = Input(LOF(fn), #fn)
            SplitArray = Split(WholeFile, vbCrLf)
            LineNumber = 1
            chkFormat1 = SplitArray(LineNumber - 1)
            Close #fn

    If InStr(1, chkFormat1, chkYesTech, vbBinaryCompare) > 0 Then
    MsgBox OpenFileName(n1) & vbNewLine & " has been verified as a YesTech AOI Inspection Results Data File"

    ' Import user selected YesTech AOI Inspection Results Data File(s) to "Raw Data" worksheet
    Application.DisplayAlerts = False
    TargetRow = 0
    Set destCell = Worksheets("Raw Data").Range("B1")
    For n2 = LBound(OpenFileName) To UBound(OpenFileName)
        fn = FreeFile
        Open OpenFileName(n2) For Input As #fn
        Application.StatusBar = "Processing ... " & OpenFileName(n2)

            ' Import data from file into Raw Data worksheet
            Do While Not EOF(fn)
            Line Input #fn, RawData
            If Len(Trim(RawData)) > 0 Then
                TargetRow = TargetRow + 1
                Worksheets("Raw Data").Range("B" & TargetRow) = RawData
            End If

        Loop

        Next n2

        Close #fn

    Set rngTarget = Worksheets("Raw Data").Range("B1" & ":" & Worksheets("Raw Data").Range("B1").End(xlDown).Address)

       With rngTarget

        .TextToColumns Destination:=destCell, DataType:=xlDelimited, _
         TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
         Semicolon:=True, Comma:=True, Space:=False, Other:=False, OtherChar:="|", _
         FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

        End With

     Application.DisplayAlerts = True

        Else: MsgBox OpenFileName(n1) & vbNewLine & " is not a YesTech AOI Inspection Results Data File."

        Exit Sub

        End If

    Next

    ' Create a number list (autofill) in Col A to maintain original import sort order
    dLastRow = Worksheets("Raw Data").Cells(Rows.Count, "B").End(xlUp).Row
    Worksheets("Raw Data").Range("A1:A" & dLastRow).Font.Color = RGB(200, 200, 200)
    Worksheets("Raw Data").Range("A1") = "1"
    Worksheets("Raw Data").Range("A2") = "2"
    Worksheets("Raw Data").Range("A1:A2").AutoFill Destination:=Worksheets("Raw Data").Range("A1:A" & dLastRow), Type:=xlFillDefault
    Worksheets("Raw Data").Range("F1:Q" & dLastRow).NumberFormat = "0.0"

    ' List open file name(s) on spreadsheet for user reference
    Worksheets("AOI Inspection Summary").Range("E9").Font.Name = "Calibri"
    Worksheets("AOI Inspection Summary").Range("E9").Font.Size = 9
    Worksheets("AOI Inspection Summary").Range("E9").Font.Bold = False
    Worksheets("AOI Inspection Summary").Range("E9").Font.Color = RGB(0, 0, 255)

    FileListRow = 0
    Set rngFileList = Worksheets("AOI Inspection Summary").Range("E9")
    For i = LBound(OpenFileName) To UBound(OpenFileName)

        ' Add imported file name hyperlink to imported files in list of imported files
        ' rngFileList.Offset(FileListRow, 0) = OpenFileName(i)
        rngFileList.Hyperlinks.Add Anchor:=rngFileList, _
        Address:=OpenFileName(i), _
        ScreenTip:="Imported File Number " & FileListRow + 1, _
        TextToDisplay:=OpenFileName(i)

        Worksheets("AOI Inspection Summary").Range("E7").Value = OpenFileName(i)

        FileListRow = FileListRow + 1

        Next i

    ' Auto fit the width of columns for RAW Data
    Worksheets("Raw Data").Columns("A:Z").EntireColumn.AutoFit

    ' Timer Stop (calculate the length of time this sub-routine took to complete)
    SecondsElapsed = Round(Timer - StartTime, 2)

    ' Turn screen updating and auto calculating back on since file processing is now complete
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    ' Display a message to report the sub-routine processing time after file selection including the number of data rows that have been imported
    MsgBox "AOI Inspection Results processed and imported in " & SecondsElapsed & " seconds" & " ." & vbNewLine & _
           "      Successfully imported " & (TargetRow) & " rows of data.", vbInformation, "Data Import Results"

' Reset to defaults in the event of a processing error during the sub-routine execution
ErrorHandler:
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    If Err.Number <> 0 Then

    ' Display a message to user including error code in the event of an error during execution
    MsgBox "An error number " & Err.Number & " was encountered!" & vbNewLine & _
           "Part or all of this VBA script was not completed.", vbInformation, "Error Message"
    End If

    Call Create_Report

End Sub

这是我定义父文件夹的尝试，使用 Application.InputBox 向用户询问子文件夹名称，并将所有 *.txt 文件名加载到要导入的数组中：

' Define that variables must be defined manually and will never be defined automatically
Option Explicit

    ' Hold specific variables in memory for use between sub-routines
    Public DDThreshold As Variant
    Public FileName As String
    Public FilePath As String
    Public OpenFileName As Variant
    Public OrderNum As Variant
    Public SaveWorkingDir As String
    Public SecondsElapsed As Double
    Public StartTime As Double
    Public TimeRemaining As Double

Sub OrderLineNum()

    ' Add an error handler
    'On Error GoTo ErrorHandler

    ' Speed up sub-routine by turning off screen updating and auto calculating
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Define variable names and data types
    Dim DefaultOpenPath As String
    Dim SaveWorkingDir As String
    Dim OrderNum As Variant
    Dim GetFile As String
    Dim FileCount As Long
    Dim OpenFileName() As String
    ReDim OpenFileName(1000)
    Dim WholeFile As String
    Dim SplitArray
    Dim LineNumber As Integer
    Dim chkFormat1 As String
    Dim i As Long
    Dim n1 As Long
    Dim n2 As Long
    Dim fn As Integer
    Dim RawData As String
    Dim rngTarget As Range
    Dim rngFileList As Range
    Dim TargetRow As Long
    Dim FileListRow As Long
    Dim aLastRow As Long
    Dim bLastRow As Long
    Dim cLastRow As Long
    Dim dLastRow As Long
    Dim destCell As Range

    ' Set the default path to start at when importing a file
    ' On Error Resume Next
    If Len(Dir("C:\AOI_DATA64\SPC_DataLog\IspnDetails", vbDirectory)) = 0 Then

        DefaultOpenPath = "C:\"

        Else

        DefaultOpenPath = "C:\AOI_DATA64\SPC_DataLog\IspnDetails\"

    End If

    ' When opening another file for processing, save the previously opened file directory
    ' On Error Resume Next
    If SaveWorkingDir = CurDir Then

    ChDrive SaveWorkingDir
    ChDir SaveWorkingDir

    Else

    ChDrive DefaultOpenPath
    ChDir DefaultOpenPath

    End If

    ' Open InputBox to get order-line number from user
    OrderNum = Application.InputBox(prompt:= _
        "Enter Order-Line Number (e.g. 12345678-9)", _
        Title:="Password Required for This Function", _
        Default:="", _
        Left:=25, _
        Top:=25, _
        HelpFile:="", _
        HelpContextID:="", _
        Type:=2)

        If OrderNum = "" Then

            MsgBox "No Order Number entered. No data will be imported.", vbInformation, "Invalid Order Number"

            Exit Sub

        ElseIf OrderNum = "0" Then

            MsgBox "Order Number cannot be 0. No data will be imported.", vbInformation, "Invalid Order Number"

            Exit Sub

        ElseIf OrderNum = False Then

            MsgBox "User cancelled. No data will be imported.", vbInformation, "User Cancelled"

            Exit Sub

        End If

    ' Create an array of filenames found in the Order-Line Number sub-folder
    GetFile = Dir$(CurDir & "\" & OrderNum & "\" & "*.txt")
    Do While GetFile <> ""
        OpenFileName(FileCount) = GetFile
        GetFile = Dir$
        FileCount = FileCount + 1
    Loop

    ReDim Preserve OpenFileName(FileCount - 1)

    ' Save the user selected open file directory as the default open file path while the worksheet is open
    SaveWorkingDir = CurDir

    ' Timer Start (calculate the length of time this sub-routine takes to complete after selecting file(s) to import)
    StartTime = Timer

    ' Cancel the file import if the Order-Line Number subfolder doesn't exist
    If Not IsArray(OpenFileName) Then

        MsgBox "" & vbNewLine & _
               "  No files were selected." & vbNewLine & _
               "" & vbNewLine & _
               "  Import AOI Inspection Results Data Files was aborted.", vbInformation, "File Import Cancelled"
        Exit Sub

    End If

    ' Clear contents of cells and data worksheets
    aLastRow = Worksheets("AOI Inspection Summary").Cells(Rows.Count, "B").End(xlDown).Row
    bLastRow = Worksheets("Raw Data").Cells(Rows.Count, "A").End(xlDown).Row
    cLastRow = Worksheets("Parsed Data").Cells(Rows.Count, "A").End(xlDown).Row

    Worksheets("AOI Inspection Summary").Range("E6:L14").ClearContents
        If aLastRow > 0 Then
        Worksheets("AOI Inspection Summary").Range("B24:L" & aLastRow).ClearContents
        Worksheets("AOI Inspection Summary").Range("B24:L" & aLastRow).ClearFormats
        End If

        If bLastRow > 0 Then
        Worksheets("Raw Data").Range("A1:Q" & bLastRow).ClearContents
        Worksheets("Raw Data").Range("A1:Q" & bLastRow).ClearFormats
        End If

        If cLastRow > 0 Then
        Worksheets("Parsed Data").Range("A1:Q" & cLastRow).ClearContents
        Worksheets("Parsed Data").Range("A1:Q" & cLastRow).ClearFormats
        End If

    ' Update "Defect Density Threshold" to default value unless user entered a new value
        If DDThreshold > 0 Then
        Worksheets("AOI Inspection Summary").Range("E10").Value = DDThreshold

        Else
        Worksheets("AOI Inspection Summary").Range("E10").Value = "3,000,000"

        End If

    'Check selected input file format for YesTech AOI Inspection Results format
    Const chkYesTech = "[StartIspn]"
    For n1 = LBound(OpenFileName) To UBound(OpenFileName)
        fn = FreeFile
        Open OpenFileName(n1) For Input As #fn
        Application.StatusBar = "Processing ... " & OpenFileName(n1)

            WholeFile = Input(LOF(fn), #fn)
            SplitArray = Split(WholeFile, vbCrLf)
            LineNumber = 1
            chkFormat1 = SplitArray(LineNumber - 1)
            Close #fn

    If InStr(1, chkFormat1, chkYesTech, vbBinaryCompare) > 0 Then
    MsgBox OpenFileName(n1) & vbNewLine & " has been verified as a YesTech AOI Inspection Results Data File"

    ' Import user selected YesTech AOI Inspection Results Data File(s) to "Raw Data" worksheet
    TargetRow = 0
    Set destCell = Worksheets("Raw Data").Range("B1")
    For n2 = LBound(OpenFileName) To UBound(OpenFileName)
        fn = FreeFile
        Open OpenFileName(n2) For Input As #fn
        Application.StatusBar = "Processing ... " & OpenFileName(n2)

        Do While Not EOF(fn)
            Line Input #fn, RawData
            If Len(Trim(RawData)) > 0 Then
                TargetRow = TargetRow + 1
                Worksheets("Raw Data").Range("B" & TargetRow) = RawData
            End If

        Loop

        Next n2

        Close #fn

     Set rngTarget = Worksheets("Raw Data").Range("B1" & ":" & Worksheets("Raw Data").Range("B1").End(xlDown).Address)

       With rngTarget

        .TextToColumns Destination:=destCell, DataType:=xlDelimited, _
         TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
         Semicolon:=True, Comma:=True, Space:=False, Other:=False, OtherChar:="|", _
         FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

        End With

        Else: MsgBox OpenFileName(n1) & vbNewLine & " is not a YesTech AOI Inspection Results Data File."

        Exit Sub

        End If

    Next

    ' Create a number list (autofill) in Col A to maintain original import sort order
    dLastRow = Worksheets("Raw Data").Cells(Rows.Count, "B").End(xlUp).Row
    Worksheets("Raw Data").Range("A1:A" & dLastRow).Font.Color = RGB(200, 200, 200)
    Worksheets("Raw Data").Range("A1") = "1"
    Worksheets("Raw Data").Range("A2") = "2"
    Worksheets("Raw Data").Range("A1:A2").AutoFill Destination:=Worksheets("Raw Data").Range("A1:A" & dLastRow), Type:=xlFillDefault
    Worksheets("Raw Data").Range("F1:Q" & dLastRow).NumberFormat = "0.0"

    ' List open file name(s) on spreadsheet for user reference
    Worksheets("AOI Inspection Summary").Range("E9").Font.Name = "Calibri"
    Worksheets("AOI Inspection Summary").Range("E9").Font.Size = 9
    Worksheets("AOI Inspection Summary").Range("E9").Font.Bold = True
    Worksheets("AOI Inspection Summary").Range("E9").Font.Color = RGB(0, 0, 255)
    FileListRow = 0
    Set rngFileList = Worksheets("AOI Inspection Summary").Range("E9")
    For i = LBound(OpenFileName) To UBound(OpenFileName)
        Debug.Print OpenFileName(i)

        ' Add imported file name or hyperlink to imported files in list of imported files
        ' rngFileList.Offset(FileListRow, 0) = OpenFileName(i)
        rngFileList.Offset(FileListRow, 0).Hyperlinks.Add Anchor:=rngFileList.Offset(FileListRow, 0), _
        Address:=OpenFileName(i), _
        ScreenTip:="Imported File Number " & FileListRow + 1, _
        TextToDisplay:=OpenFileName(i)
        rngFileList.Offset(FileListRow, 0).Font.Name = "Calibri"
        rngFileList.Offset(FileListRow, 0).Font.Size = 9
        rngFileList.Offset(FileListRow, 0).Font.Color = RGB(0, 0, 255)

        FileListRow = FileListRow + 1

        Next i

    ' Auto fit the width of columns for RAW Data
    Worksheets("Raw Data").Columns("A:Z").EntireColumn.AutoFit

    ' Timer Stop (calculate the length of time this sub-routine took to complete)
    SecondsElapsed = Round(Timer - StartTime, 2)

    ' Turn screen updating and auto calculating back on since file processing is now complete
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    ' Display a message to report the sub-routine processing time after file selection including the number of data rows that have been imported
    MsgBox "AOI Inspection Results processed and imported in " & SecondsElapsed & " seconds" & " ." & vbNewLine & _
           "      Successfully imported " & (TargetRow) & " rows of data.", vbInformation, "Data Import Results"

' Reset to defaults in the event of a processing error during the sub-routine execution
ErrorHandler:
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    If Err.Number <> 0 Then

    ' Display a message to user including error code in the event of an error during execution
    MsgBox "An error number " & Err.Number & " was encountered!" & vbNewLine & _
           "Part or all of this VBA script was not completed.", vbInformation, "Error Message"
    End If

End Sub

任何关于更好方法的想法或建议将不胜感激。

【问题讨论】：

对不起，您的帖子中有很多文字和信息。能否请您解析为minimal reproducible example，重点关注代码中不起作用的方面？ 【参考方案1】：

正如我在评论中提到的，您的帖子中有很多内容。但是，专注于此

我现在尝试将父文件夹定义为变量，允许用户使用 Application.InputBox 输入子文件夹名称，然后自动从用户指定的子文件夹中的所有 .txt 文件中导入数据。

我有一个解决方案 - 你可以创建一个数组来存储每个文件（路径和文件名），你应该能够使用它来获取文件名，然后做你需要的任何事情：

Sub import_files()
Dim files As String
Dim parentDir As String

parentDir = InputBox("Please input the directory you want to import files from")
If parentDir = "" Then Exit Sub 'If they hit "Cancel" or don't put anything.
' parentDir = GetFolder() 'UNCOMMENT THIS if you want the user to select a folder via "Windows Explorer"
files = LoopThroughFiles(parentDir, "txt")
' Debug.Print (files)

Dim iFiles() As String
iFiles() = Split(files, ",")

Dim i As Long
For i = LBound(iFiles) To UBound(iFiles)
    If iFiles(i) <> "" Then
        Debug.Print ("File located: " + parentDir + "\" + iFiles(i))
        ' THIS IS YOUR ARRAY, `iFILES`, SO HERE IS WHERE YOU DO STUFF
    End If
Next i

End Sub
Private Function LoopThroughFiles(inputDirectoryToScanForFile, filenameCriteria) As String
'https://***.com/a/45749626/4650297
Dim tmpOut As String
    Dim StrFile As String
    'Debug.Print "in LoopThroughFiles. inputDirectoryToScanForFile: ", inputDirectoryToScanForFile
    StrFile = Dir(inputDirectoryToScanForFile & "\*" & filenameCriteria)
    Do While Len(StrFile) > 0
        ' Debug.Print StrFile
        tmpOut = tmpOut + "," + StrFile
        StrFile = Dir
    Loop
    LoopThroughFiles = tmpOut
End Function
Function GetFolder() As String
' https://***.com/a/26392703/4650297
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

编辑：我添加了一种方法，让用户通过更“传统”的 Windows 资源管理器类型窗口选择文件夹，而不是粘贴路径字符串。不过，任何一个都应该适合你，有任何问题都可以告诉我。

【讨论】：

以上是关于在文件夹中创建文件名数组 - Excel VBA的主要内容，如果未能解决你的问题，请参考以下文章

Excel VBA 连接 Outlook 以在根文件夹中创建文件夹

在 Excel VBA 中创建文件夹和子文件夹

vbscript [Excel VBA中的时间戳]在Excel VBA #Excel VBA中创建时间戳字符串

Excel VBA 在非默认日历中创建会议

从 Excel 填充访问记录

如何使用 VBA 将事件添加到运行时在 Excel 中创建的控件