Faxデータ削除（再帰処理）

フォルダ内のFaxデータをまとめて削除する。
条件は更新日が二週間前。

Faxフォルダの中にデータが入っているがフォルダの数に規則性はない。

Faxフォルダ
　20210411
　　Aさん

　　　PDFデータ

f:id:abv72:20210412144347p:plain

再帰処理を行い、フォルダ内すべてのデータに対して処理を行う。

Dim ws As Worksheet 'Sheet1
Dim tRow As Long 'Sheet1の記入行番号

Sub 再帰処理()
Dim FD As FileDialog
Dim FolderName As String
Dim fso As New Scripting.FileSystemObject
Dim FldObj As Scripting.Folder

Set ws = Worksheets("Sheet1")
tRow = 2

Set FD = Application.FileDialog(msoFileDialogFolderPicker)
If FD.Show = True Then
FolderName = FD.SelectedItems(1)
Set FldObj = fso.GetFolder(FolderName)
Call FolderAnalyze(FldObj)
End If

End Sub

Sub FolderAnalyze(FldObj As Scripting.Folder)

Dim FileObj As Scripting.File
Dim SubFld As Scripting.Folder

For Each FileObj In FldObj.Files
' ws.Cells(tRow, 1).Value = FileObj.Name
' ws.Cells(tRow, 2).Value = FileObj.DateLastModified
' ws.Cells(tRow, 3).Value = FileObj.ParentFolder.Path
' tRow = tRow + 1

'Faxデータ削除処理（仮）2週間前という条件設定が上手く行っていない

' If FileObj.DateLastModified < Now() - 28 Then
Debug.Print FileObj.Name
Debug.Print FileObj.DateLastModified
Debug.Print Now() - 28
' Else
' End If

Next

For Each SubFld In FldObj.SubFolders
Call FolderAnalyze(SubFld)
Next

End Sub