VBA Macro to Convert Word Docs to PDF with Looping through Subfolders?

[32758925723095]

I am trying to adapt the below VBA code, which converts all Word documents in a given folder into PDFs, in order to also do the same to all other Words documents found in all subfolders cascading downwards from the original folder:

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; white-space: inherit;">Sub BulkConvertDocToPDF()
Dim oFileDlg As FileDialog
Dim strFolder As String
Dim strFileName As String
Dim oDoc As Document
Dim rsp As VbMsgBoxResult

' Tell user what's happening
rsp = MsgBox( _
    prompt:="Convert all documents in a folder to PDF format?" & _
        vbCr & "If yes, select the folder in the next dialog.", _
    buttons:=vbYesNo + vbExclamation, _
    Title:="Bulk Convert to PDF")
If rsp = vbYes Then
    ' Prepare and show folder picker dialog
    Set oFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    With oFileDlg
        .Title = "Bulk Convert to PDF"
        .AllowMultiSelect = False
        ' Start in user's Documents folder
        .InitialFileName = 
Application.Options.DefaultFilePath(wdDocumentsPath)
        If .Show = -1 Then
            ' User clicked OK; get selected path
            strFolder = .SelectedItems(1) & ""
        End If
    End With
    ' Remove dialog object from memory
    Set oFileDlg = Nothing
End If

If Not strFolder = "" Then
    strFileName = Dir(pathname:=strFolder & "*.doc*")
    WordBasic.DisableAutoMacros 1   'Disables auto macros
    Application.ScreenUpdating = False

    While strFileName <> ""
        ' Set an error handler
        On Error Resume Next

        ' Attempt to open the document
        Set oDoc = Documents.Open( _
            FileName:=strFolder & strFileName, _
            PasswordDocument:="?#nonsense@$")

        ' Check for error that indicates password protection
        Select Case Err.Number
            Case 0
                ' Document successfully opened
                ' Do nothing here
            Case 5408
                 ' Document is Password-protected and was NOT Opened
                Debug.Print strFileName & " is password-protected " & _
                    "and was NOT processed."
                ' Clear Error Object and Disable Error Handler
                Err.Clear
                On Error GoTo 0
                ' Get Next Document
                GoTo GetNextDoc

            Case Else
                ' Another Error Occurred
                MsgBox "Error " & Err.Number & vbCr & Err.Description
        End Select

        ' Change extension from .doc* to .pdf
        strFileName = Replace(LCase(strFileName), ".doc", ".pdf")
        If Right(strFileName, 1) = "x" Or Right(strFileName, 1) = "m" 
Then
            strFileName = Left(strFileName, Len(strFileName) - 1)
        End If

        ' Save the file in PDF format
        oDoc.SaveAs2 FileName:=strFolder & strFileName, 
FileFormat:=wdFormatPDF

        ' Close the document and clear the object
        oDoc.Close SaveChanges:=wdDoNotSaveChanges
        Set oDoc = Nothing

GetNextDoc:
        ' Get the next file name
        strFileName = Dir()
    Wend
End If
WordBasic.DisableAutoMacros 0   'Enables auto macros
Application.ScreenUpdating = True
End Sub</code>

I tried to implement the following non-recursive loop code, but I'm afraid I'm not proficient enough at this stage:

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; white-space: inherit;">Public Sub NonRecursiveMethod()
Dim fso, oFolder, oSubfolder, oFile, queue As Collection

Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder("your folder path variable") 'obviously replace

Do While queue.Count > 0
    Set oFolder = queue(1)
    queue.Remove 1 'dequeue
    '...insert any folder processing code here...
    For Each oSubfolder In oFolder.SubFolders
        queue.Add oSubfolder 'enqueue
    Next oSubfolder
    For Each oFile In oFolder.Files
        '...insert any file processing code here...
    Next oFile
Loop

End Sub</code>

Any advice on how I should go about modifying the original code in order to accomplish my goal?

Credit for original code cited above:

Loop code
Convert Word to PDF code