[Loop Folders & SubFolders] Loop through a folder and act on specific files in that folder #VBA #Excel #Word

Document_Cleanse.bas

Attribute VB_Name = "Document_Cleanse"
Option Explicit

Sub LoopFolder()

'from https://www.mrexcel.com/forum/excel-questions/866125-vba-loop-through-all-files-all-subfolders.html
    Dim fso As New FileSystemObject
    Dim f As Folder, sf As Folder
    Dim ofile As File
    Dim MyPath As String, RootFolder As String

   RootFolder = ChooseFolder()
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Set f = fso.GetFolder(RootFolder)
    For Each sf In f.SubFolders
        For Each ofile In sf.Files
            If fso.GetExtensionName(ofile.Path) = "doc" Or _
                    fso.GetExtensionName(ofile.Path) = "docx" Then
                    MsgBox ofile.Name
            End If
        Next
    Next


End Sub

Function ChooseFolder() As String
'adapted from https://www.wiseowl.co.uk/blog/s209/type-filedialog.htm

Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
'the number of the button chosen

Dim FolderChosen As Integer

With fd

    FolderChosen = .Show
    
    .Title = "Choose folder containing files to change author"
    
    .InitialFileName = "c:\"
    
    .InitialView = msoFileDialogViewList

    If FolderChosen <> -1 Then
        Exit Function
    Else
        ChooseFolder = .SelectedItems(1)
    End If
End With
End Function