View Single Post
Old 11-22-2022, 06:07 PM
MurphyMom MurphyMom is offline Mac OS X Office 2021
Join Date: Nov 2022
Posts: 5
MurphyMom is on a distinguished road

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".

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)
        End With
    End If
strFile = Dir()

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
                    .SaveAs2 ActiveDocument.Path & "" & wdDoc & "x", fileformat:=wdFormatDocumentDefault
                End With

    Exit Sub
End Sub
Reply With Quote