How to make this code apply recursively to all sub-folders

I found this code to change .doc files to .docx files. I would like to modify it so I can specify a top level folder and have it work through it AND every sub-folder. Appreciate any assistance.

Sub TranslateDocIntoDocx()
  Dim objWordApplication As New Word.Application
  Dim objWordDocument As Word.Document
  Dim strFile As String
  Dim strFolder As String

  strFolder = "C:\Temp\doc\"
  strFile = Dir(strFolder & "*.doc", vbNormal)

  While strFile <> ""
    With objWordApplication
      Set objWordDocument = .Documents.Open(FileName:=strFolder & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)

      With objWordDocument
        .SaveAs FileName:=strFolder & Replace(strFile, "doc", "docx"), FileFormat:=16
        .Close
      End With
    End With
    strFile = Dir()
  Wend

  Set objWordDocument = Nothing
  Set objWordApplication = Nothing
End Sub

I suggest switching from Dir to FileSystemObject. With FSO, you can get a folder as an object with GetFolder and then access the Folder Object's files and folders as collections. This enables For Each loops like For Each File In Folder. and then you can do the recursion For Each SubFolder In Folder where you can re-call the macro as if each subfolder was the top level folder.

Sub TranslateDocIntoDocx()
    Dim objWordApplication As New Word.Application

    Dim strFolder As String
    strFolder = "C:\Temp\doc\"
    
    Dim StartingFolder As Object
    Set StartingFolder = CreateObject("Scripting.FileSystemObject").GetFolder(strFolder)
    
    
    FolderToDocx StartingFolder, objWordApplication
    
    Set objWordApplication = Nothing
End Sub
Sub FolderToDocx(Folder As Object, wdApp As Word.Application)
    Dim File As Object
    For Each File In Folder.Files
        If LCase(Split(File.Name, ".")(1)) = "doc" Then SaveToDocx File, wdApp
    Next
    
    Dim SubFolder As Object
    For Each SubFolder In Folder.Subfolders
        FolderToDocx SubFolder, wdApp
    Next
End Sub

Sub SaveToDocx(File As Object, wdApp As Word.Application)
    With wdApp.Documents.Open(File.Path, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
        .SaveAs Filename:=File.Path & "x"), FileFormat:=16
        .Close
    End With
End Sub

The file matching expression I did in this answer is just an example. You may want to improve that expression to prevent errors. One error that may come up is with Microsoft Office temp files. They are usually hidden and prefixed with ~$ like ~$Word Document.docx. So to avoid accidentally matching one of those, it would be good to exclude anything with that prefix.

I would recommend splitting out the file searching into a separate function: it's easier to tweak your logic and the main method doesn't get overloaded by the code for finding the files.

Sub TranslateDocIntoDocx()
    Dim objWordApplication As New Word.Application
    Dim objWordDocument As Word.Document
    Dim colFiles As Collection
    Dim strFile
  
    Set colFiles = GetMatchingFiles("C:\Temp\doc\", "*.doc")
    For Each strFile In colFiles
        With objWordApplication
            Set objWordDocument = .Documents.Open(Filename:=strFile, _
                     AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
    
            With objWordDocument
                .SaveAs Filename:=strFile & "x", FileFormat:=16
                .Close
            End With
        End With
    Next strFile
End Sub


'Search beginning at supplied folder root, including subfolders, for
'   files matching the supplied pattern.  Return all matches in a Collection
Function GetMatchingFiles(startPath As String, filePattern As String) As Collection 'of paths
    Dim colFolders As New Collection, colFiles As New Collection
    Dim fso As Object, fldr, subfldr, fl
    
    Set fso = CreateObject("scripting.filesystemobject")
    colFolders.Add startPath         'queue up root folder for processing
    
    Do While colFolders.Count > 0 'loop until the queue is empty
        fldr = colFolders(1)      'get next folder from queue
        colFolders.Remove 1       'remove current folder from queue
        With fso.getfolder(fldr)
            For Each fl In .Files
                If UCase(fl.Name) Like UCase(filePattern) Then  'check pattern
                    colFiles.Add fl.Path     'collect the full path
                End If
            Next fl
            For Each subfldr In .subFolders
                colFolders.Add subfldr.Path 'queue any subfolders
            Next subfldr
        End With
    Loop
    Set GetMatchingFiles = colFiles
End Function