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