Excel 如何使用VBA从特定子文件夹打开xlsm文件？

我正在处理宏，该宏从剪贴板获取路径，遍历该路径中的每个文件夹和子文件夹，在财务子文件夹中打开xlsm文件并删除KPI表。在下面的“我的路径”中可以找到文件夹结构：

p:\main folder\project folder\finance子文件夹\

p:\main folder\project folder\brief子文件夹\

p:\main folder\project folder\production子文件夹\

p:\main folder\project folder\delivery子文件夹\

p:\main folder\project folder\feedback子文件夹\

基本上，我复制“p:\main folder\”，我的宏遍历所有项目文件夹和所有子文件夹。我想优化这个过程，并编写一个代码，通过主文件夹中的所有项目文件夹，然后只进入财务子文件夹并查找xlsm文件。我曾尝试使用发布的代码，但只有当我将“P:\main folder\project folder”路径放在“P:\main folder”路径时，它才起作用

据我所知，原因是我的宏正在寻找财务子文件夹，不是在项目文件夹中，而是在主文件夹中，但这只是我的猜测。您可以在下面找到代码：

Sub test_macro()
Dim oLibrary As Object
Dim srcFolder As Object
Dim folderName As String
Dim clipboard As MSForms.DataObject
Dim CopiedText As String

Set clipboard = New MSForms.DataObject
clipboard.GetFromClipboard
CopiedText = clipboard.GetText

folderName = CopiedText
If StrPtr(folderName) = 0 Then
    Exit Sub
End If

Set oLibrary = CreateObject("Scripting.FileSystemObject")
Merge_Rows oLibrary.GetFolder(folderName)
End Sub

Sub Merge_Rows(srcFolder As Object)

Dim srcSubFolder As Object
Dim srcFile As Object

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

For Each srcSubFolder In srcFolder.SubFolders
    If Split(srcSubFolder, "\")(UBound(Split(srcSubFolder, "\"))) = "1_FINANCE" Then '<-- my guess is that here is the problem but not sure how to fix it
        Merge_Rows srcSubFolder
    End If
Next

For Each srcFile In srcFolder.Files
     If LCase(srcFile.Name) Like "*.xlsm" Then
     Set wbkSource = Workbooks.Open(srcFile)

        On Error Resume Next
        Application.DisplayAlerts = False
        wbkSource.Sheets("KPI").Delete
        Application.DisplayAlerts = True
        wbkSource.Close SaveChanges:=True
    End If
Next
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

子测试_宏（）
作为对象的图书馆
将文件夹设置为对象
Dim folderName作为字符串
将剪贴板设置为MSForms.DataObject
以字符串形式复制文本
设置剪贴板=新建MSForms.DataObject
剪贴板.GetFromClipboard
CopiedText=clipboard.GetText
folderName=CopiedText
如果strprpr（folderName）=0，则
出口接头
如果结束
Set oLibrary=CreateObject（“Scripting.FileSystemObject”）
合并行oLibrary.GetFolder（folderName）
端接头
子合并_行（srcFolder作为对象）
将子文件夹设置为对象
将文件作为对象
应用
.ScreenUpdate=False
.EnableEvents=False
以
对于srcFolder.SubFolders中的每个srcFolder子文件夹
如果Split（srcSubFolder，“\”）（UBound（Split（srcSubFolder，“\”））=“1\u FINANCE”，那么“这是我的想法，但它是针对2级子文件夹完成的（如果我正确理解任务）：

子合并_行（）
将文件夹设置为对象
将子文件夹设置为对象
将srcsubfolder作为对象
将文件作为对象
作为对象的图书馆
“这是我的测试车
Dim FolderName作为字符串
FolderName=“P:\”
'''''''''
'将需要它，因为我没有将文件夹传递给sub
Set oLibrary=CreateObject（“Scripting.FileSystemObject”）
Set srcFolder=oLibrary.getfolder（FolderName）
应用
.ScreenUpdate=False
.EnableEvents=False
以
'添加用于测试目的
将文件计数器设置为长
调试。打印“---------------------”和“源文件夹：&FolderName&”-------------------------------------”
调试.打印Chr（10）
对于srcFolder中的每个srcFolder.Subfolders'转到子文件夹
'打印级别1子文件夹名称，该名称应为项目文件夹
对于srcSubFolder中的每个srcSubSubFolder。子文件夹“转到子文件夹”
'打印级别2子文件夹名称，该名称应为项目文件夹子文件夹
Debug.Print“-------------当前子文件夹为：&FolderName&srcSubFolder.Name&“------------”
如果UCase（srcsubfolder.Name）像“*FINANCE*”然后“您只需要从财务子文件夹中获取文件？是\project folder\one文件夹还是更像\main folder\中有100个项目文件夹，并且您需要每个项目文件夹中的财务文件夹？项目文件夹中始终有5个子文件夹，但每个子文件夹中有多个不同的文件，这就是我在finance子文件夹中查找xlsm文件的原因。非常感谢您的帮助。代码运行正常，但仍有一个小问题，脚本转到finance子文件夹并查找xlsm，但随后转到Short、production和delivery子文件夹，然后转到next project文件夹。我想省略项目文件夹中除财务子文件夹外的所有子文件夹。@Adrian我已将更新添加到我的帖子中，请查看！非常感谢@Vitaliy Prushak。我的问题现在解决了：）
Sub Merge_Rows()
Dim srcFolder As Object
Dim srcSubFolder As Object
Dim srcSubSubFolder As Object
Dim srcFile As Object
Dim oLibrary As Object


' This is my testing vars
Dim FolderName As String
FolderName = "P:\"
'''''''''

' will need it as I'm not passing the folder to sub
Set oLibrary = CreateObject("Scripting.FileSystemObject")
Set srcFolder = oLibrary.getfolder(FolderName)

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

' added for testing purposes
Dim fileCounter As Long

    Debug.Print "-----------------" & "Source folder: " & FolderName & "--------------------------------"
    Debug.Print Chr(10)

For Each srcSubFolder In srcFolder.Subfolders ' going to subfolders

    ' print the level 1 subfolder name, which should be a project folder

    For Each srcSubSubFolder In srcSubFolder.Subfolders ' going to sub-subfolder

        ' print the level 2 subfolder name, which should be a project folder subfolder
        Debug.Print "----------- Current SubFolder is: " & FolderName & srcSubFolder.Name & "-----------------"
        If UCase(srcSubSubFolder.Name) Like "*FINANCE*" Then '<--!! put proper pattern
            ' go through it at once
            For Each srcFile In srcSubSubFolder.Files

            Debug.Print "----------------- Current SubSubFolder is: " & FolderName & srcSubFolder.Name & "\" & srcSubSubFolder.Name & "---------------------"

                If LCase(srcFile.Name) Like "*.xlsm" Then
                    Debug.Print srcFile.Name
                    fileCounter = fileCounter + 1
                    ' Your code here
                End If
            Next
        End If
        If Not fileCounter = 0 Then
            Debug.Print "There were " & fileCounter & " .xlsm files in " & FolderName & srcSubFolder.Name & "\" & srcSubSubFolder.Name
            fileCounter = 0
        Else
            Debug.Print "The search of .xlsm files in " & FolderName & srcSubFolder.Name & "\" & srcSubSubFolder.Name & " was not performed"
        End If
        Debug.Print "-----------------" & "End of current SubSubFolder: " & FolderName & srcSubFolder.Name & "\" & srcSubSubFolder.Name & "---------------------"
    Next
    Debug.Print "-----------------" & "End current SubFolder: " & FolderName & srcSubFolder.Name & "---------------------"
    Debug.Print Chr(10) & Chr(10)
Next

Debug.Print "<-----------------" & "End Source Folder" & "--------------------->"

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub