Loop through all .doc documents in all folders and subfolder, convert, save as to a different folder

MurphyMom · #2 11-22-2022, 06:07 PM

This is what I have so far. It's not great, but it kind of works. The user has to select the folder where the documents are stored, the macro will loop through the folder and convert any documents that are in .doc format. I'm not sure if there are any that are in .docx format in these folders, so I thought I would build an exit if it encountered any and errored on the convert code.

Ultimately, I would like to:

1. Be able to loop through all folders and subfolders if possible. The folders specifically that contains the documents to be converted is called "Cannot Upload", but that same folder name could be a subfolder in multiple folders.

2. It would be awesome if I could save the converted documents to another folder called "Converted Files".

Code:

Sub Loop_AllWordFiles_inFolder()

'Optimize Macro Speed
Application.ScreenUpdating = False
Dim strDocNm As String, strFolder As String, strFile As String, wdDoc As Document
Dim sFolderPath As String
'Get form user where the path to the folder is
strFolder = GetFolder
If strFolder = "" Then Exit Sub
'strFile = Dir(strFolder & "\Cannot Upload" & "*.doc", vbNormal)
strFile = Dir(strFolder & "\*.doc", vbNormal)
strDocNm = ThisDocument.FullName
aFile = strFolder
While strFile <> ""
    If strFolder & "" & strFile <> strDocNm Then
        Set wdDoc = Documents.Open(FileName:=strFolder & "" & strFile, AddToRecentFiles:=False, Visible:=True)
        With wdDoc
           Call ConvertDoc(wdDoc)
           .Close
        End With
    End If
    
strFile = Dir()

Wend
MsgBox "Finished scanning all files in Folder " & Path
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").browseforfolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.items.Item.Path
Set oFolder = Nothing
End Function
Sub ConvertDoc(wdDoc As Document)
'macro created to open an old .doc file and convert to new word file
 
                With wdDoc
                    On Error GoTo lbl_exit
                    .Convert
                    .SaveAs2 ActiveDocument.Path & "" & wdDoc & "x", fileformat:=wdFormatDocumentDefault
                End With

lbl_exit:
    Exit Sub
End Sub

Thread Tools
Show Printable Version Email this Page
Display Modes
Switch to Linear Mode Switch to Hybrid Mode Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Loop Through all documents in a folder	ballpoint	Word VBA	10	08-15-2022 05:24 PM
loop through all documents in a folder, search and replace text, save document ONLY IF CHANGE MADE	shpkmom	Word VBA	1	08-15-2022 05:16 PM
Combine 2 word documents in subfolder and save on same location	D1985	Word VBA	5	03-29-2022 01:39 PM
Office 2010 Can't Open Or Save Documents in My Documents Folder	trippb	Office	1	07-12-2013 07:29 AM
Add folder and subfolder to Favorite	ying06	Outlook	0	03-30-2012 10:41 AM