excel 2007 vba,删除匹配的文件夹名称

我试图压缩通过一个文件夹,并删除与名称匹配的子文件夹。 目录有这样的结构。

<starting path> <starting path>\<main folder> <starting path>\<main folder>\<sub folder> 

我有下面的VBA工作 – 直到第一场比赛,并删除。 之后,我得到一个path错误找不到。 我不知道如何(在删除文件夹后)将它撞到起始path – 或者只是移动到下一个主文件夹,让它再次滚动。

 'Looping Through Folders and Files in VBA Public ObjFolder As Object Public objFso As Object Public objFldLoop As Object Public lngCounter As Long Public objFl As Object '=================================================================== 'A procedure to call the Function LoopThroughEachFolder(objFolder) '=================================================================== Sub GetFolderStructure() ' lngCounter = 0 Set objFso = CreateObject("Scripting.FileSystemObject") With Application.FileDialog(msoFileDialogFolderPicker) .Show Set ObjFolder = objFso.GetFolder(.SelectedItems(1)) End With LoopThroughEachFolder ObjFolder End Sub '=================================================== 'Function to Loop through each Sub Folders '=================================================== Function LoopThroughEachFolder(fldFolder As Object) Dim P As Long For Each objFldLoop In fldFolder.subFolders lngCounter = lngCounter + 1 P = InStr(1, objFldLoop.Path, "\TREATS") If P <> 0 Then Range("A1").Offset(lngCounter).Value = Mid(objFldLoop.Path, P, 10) MsgBox objFldLoop.Path objFso.DeleteFolder objFldLoop End If LoopThroughEachFolder objFldLoop Next End Function 

====更新的工作代码=====

 'Looping Through Folders and Files in VBA Public ObjFolder As Object Public objFso As Object Public objFldLoop As Object Public lngCounter As Long Public objFl As Object '=================================================================== 'A procedure to call the Function LoopThroughEachFolder(objFolder) '=================================================================== Sub GetFolderStructure() ' lngCounter = 0 Set objFso = CreateObject("Scripting.FileSystemObject") With Application.FileDialog(msoFileDialogFolderPicker) .Show Set ObjFolder = objFso.GetFolder(.SelectedItems(1)) End With LoopThroughEachFolder ObjFolder End Sub '=================================================== 'Function to Loop through each Sub Folders '=================================================== Function LoopThroughEachFolder(fldFolder As Object) Dim P As Long For Each objFldLoop In fldFolder.subFolders P = InStr(1, objFldLoop.Path, "\TREATS") If P <> 0 Then objFso.DeleteFolder objFldLoop Else LoopThroughEachFolder objFldLoop End If Next End Function