自分用です。

ファイル名に空白が入っていれば取るようにします。
直下のフォルダと更に下のフォルダがあり、更に下のフォルダには回覧板まとめという語を含みます。
今日ファイルが更新された時点で取ります。

Option Explicit

Dim monitoringDone1 As Boolean
Dim monitoringDone2 As Boolean

Sub StartMonitoring()
    monitoringDone1 = False
    monitoringDone2 = False
    CheckFolders
End Sub

Sub CheckFolders()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim folder1 As String
    folder1 = "C:\Users\hoge\Desktop\geho"

    ' folder2候補を「回覧板まとめ」を含むサブフォルダ2つから取得
    Dim folder2List As Collection
    Set folder2List = GetSubFoldersWithKeyword(folder1, "回覧板まとめ")

    ' folder1 の処理(直下)
    If Not monitoringDone1 Then
        monitoringDone1 = CheckFilesInFolder(folder1, fso)
    End If

    ' folder2 の処理(複数候補)
    Dim folder2DoneCount As Integer: folder2DoneCount = 0
    Dim folderPath As Variant
    For Each folderPath In folder2List
        If CheckFilesInFolder(folderPath, fso) Then
            folder2DoneCount = folder2DoneCount + 1
        End If
    Next

    ' 2つとも完了したときだけ monitoringDone2 を True にする
    If folder2DoneCount >= 2 Then
        monitoringDone2 = True
    End If

    ' 両方完了でループ終了
    If monitoringDone1 And monitoringDone2 Then
        MsgBox "すべての監視対象ファイルが更新&空白除去されました。", vbInformation
    Else
        Application.OnTime Now + TimeValue("00:01:00"), "CheckFolders"
    End If
End Sub

Function CheckFilesInFolder(folderPath As Variant, fso As Object) As Boolean
    Dim file As Object
    Dim cleaned As Boolean: cleaned = False

    If Not fso.FolderExists(folderPath) Then Exit Function

    For Each file In fso.GetFolder(folderPath).Files
        If InStr(file.Name, "回覧板まとめ") > 0 Then
            If DateValue(file.DateLastModified) = Date Then
                If InStr(file.Name, " ") > 0 Then
                    Dim newName As String
                    newName = Replace(file.Name, " ", "")
                    Dim newPath As String
                    newPath = fso.BuildPath(folderPath, newName)
                    If Not fso.FileExists(newPath) Then
                        Name file.path As newPath
                        MsgBox "空白を削除しました: " & newName, vbInformation
                    End If
                End If
                cleaned = True
                Exit For
            End If
        End If
    Next

    CheckFilesInFolder = cleaned
End Function

Function GetSubFoldersWithKeyword(basePath As String, keyword As String) As Collection
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim folder As Object
    Dim result As New Collection

    If fso.FolderExists(basePath) Then
        For Each folder In fso.GetFolder(basePath).SubFolders
            If InStr(folder.Name, keyword) > 0 Then
                result.Add folder.path
            End If
        Next
    End If

    Set GetSubFoldersWithKeyword = result
End Function

 

おすすめの記事