Microsoft Office Forums - View Single Post

gmayor · 02-10-2022, 05:12 AM

This type of process needs a touch of error handling e.g.

Code:

Sub ConvertDocToDocx()
Dim oDlg As FileDialog
Dim sFolder As String
Dim sName As String, sFullName As String
Dim oDoc As Document
Dim i As Integer: i = 0
    Application.ScreenUpdating = False
    Set oDlg = Application.FileDialog(msoFileDialogFolderPicker)
    If oDlg.Show <> -1 Then Exit Sub
    sFolder = oDlg.SelectedItems(1) + "\"
    sName = Dir(sFolder & "*.doc", vbNormal)
    While sName <> ""
        If Right(LCase(sName), 3) = "doc" Then
            i = i + 1
            Set oDoc = Documents.Open(FileName:=sFolder & sName, _
                                      ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
                                      PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
                                      WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
                                      wdOpenFormatAuto, XMLTransform:="")
            sFullName = Left(oDoc.FullName, InStrRev(oDoc.FullName, Chr(46)))
            If ActiveDocument.HasVBProject = True Then
                ActiveDocument.SaveAs sFullName & "docm", wdFormatXMLDocumentMacroEnabled
            Else
                ActiveDocument.SaveAs sFullName & "docx", wdFormatXMLDocument
            End If
            ActiveDocument.Close
        End If
        sName = Dir()
    Wend
    Application.ScreenUpdating = True
    If i = 1 Then
        MsgBox i & " document converted"
    Else
        MsgBox i & " documents converted"
    End If
    Set oDoc = Nothing
    Set oDlg = Nothing
End Sub

Or you could use Document Batch Processes which has even more error handling and avoids the overwriting of existing files with the same new names.