Excel文件夹扫描VBA宏如何设置固定路径跳过选择弹窗

核心修改逻辑 #

原来的弹窗选择文件夹功能由BrowseForFolder方法实现，只需要删除这段弹窗逻辑，直接给MyPath变量赋值固定路径即可，具体操作如下：

1. 删除以下整段弹窗选择文件夹的代码：

'Select folder
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Please select the folder you would like to scan", 0, 0)
If Not objFolder Is Nothing Then
    MyPath = objFolder.self.Path & "\"
    ThisWorkbook.Worksheets("Sheet1").Range("B3").Value = MyPath
Else
    Exit Sub
End If
Set objFolder = Nothing
Set objShell = Nothing

2. 在删除代码的位置，添加MyPath的固定路径赋值代码，两种可选方案：

• 方案A：直接硬编码固定路径（适合路径永久不变的场景），示例：

' 配置固定扫描路径，替换为你实际的文件夹路径，末尾保留反斜杠
MyPath = "C:\你要固定的父文件夹路径\"
' 保留原有路径写入Sheet1的功能，不需要可以删掉
ThisWorkbook.Worksheets("Sheet1").Range("B3").Value = MyPath

• 方案B：复用原有代码中读取Makro表C4单元格的路径配置（适合需要偶尔改路径又不想动代码的场景）：

' 直接读取Makro表C4单元格的路径作为固定扫描路径
MyPath = strFolderToScan
' 保留原有路径写入Sheet1的功能，不需要可以删掉
ThisWorkbook.Worksheets("Sheet1").Range("B3").Value = MyPath

修改后完整参考代码 #

Dim MyPath As String, MyFolderName As String, MyFileName As String, strStartCell2 As String, strFolderToScan As String
Dim i As Integer
Dim F As Boolean
Dim objShell As Object, objFolder As Object, AllFolders As Object, AllFiles As Object, strFileFormat As Object, fso As Object
Dim MySheet As Worksheet

'Define variables and constants
Set strFileFormat = ThisWorkbook.Worksheets("Makro").Range("A6")
strStartCell2 = strStartCell
strFolderToScan = ThisWorkbook.Worksheets("Makro").Range("C4").Value & "\"

' 配置固定扫描路径，以下二选一即可
' 方案A：硬编码路径，替换为自己的路径
' MyPath = "C:\你要固定的父文件夹路径\"
' 方案B：读取C4单元格路径
MyPath = strFolderToScan
ThisWorkbook.Worksheets("Sheet1").Range("B3").Value = MyPath
 
'List all folders
Set AllFolders = CreateObject("Scripting.Dictionary")
Set AllFiles = CreateObject("Scripting.Dictionary")
AllFolders.Add (MyPath), ""
i = 0
Do While i < AllFolders.Count
    Key = AllFolders.keys
    MyFolderName = Dir(Key(i), vbDirectory)
    Do While MyFolderName <> ""
        If MyFolderName <> "." And MyFolderName <> ".." Then
            If (GetAttr(Key(i) & MyFolderName) And vbDirectory) = vbDirectory Then
                AllFolders.Add (Key(i) & MyFolderName & "\"), ""
            End If
        End If
        MyFolderName = Dir
    Loop
    i = i + 1
Loop
 
'List all files
For Each Key In AllFolders.keys
    MyFileName = Dir(Key & "*." & strFileFormat)
    Do While MyFileName <> ""
        AllFiles.Add (Key & MyFileName), ""
        MyFileName = Dir
    Loop
Next
 
'List all files in Files sheet
Sheets("Makro").Range(strStartCell2).Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.keys)
Set AllFolders = Nothing
Set AllFiles = Nothing

注意事项 #

• 配置的固定路径需要确保真实存在，且当前Excel进程有该路径的读取权限，否则宏运行会报错
• 路径末尾需要保留反斜杠\，避免路径拼接错误

内容的提问来源于stack exchange，提问作者ExcelNoob80