Bulk-Convert Word .doc files to .docx

There are several reasons why bulk converting old Microsoft Office documents can be worthwhile. The new files are typically much smaller, present fewer security risks and are less likely to be blocked by default, either now or in the future.

• The macro below will turn off Compatibility Mode for every file it saves, this may involve some data loss, typically the colours of some items may change and add-in content like Word-Art may be lost.
• When converting older Word files you may need to Open the Trust Centre ➞ File Block settings and untick the File Block.
  You may also have to allow VBA macros to run under Macro Security settings.
• The script below does not delete the original files. You could add a VBA KILL command to do that if desired, but I strongly recommend checking that the file conversions have worked first.
• The same approach can be used for .DOT Template files, just change "doc" to "dot" in the script.
• Files containing Macros may not convert correctly unless you manually open them and Save As, this is particularly an issue with older (pre-2003) Word Basic macros. Check that every .docm or .dotm file opens and works as expected before deleting the originals.

When this macro is run, it will prompt for a FOLDER and will then convert all documents in that folder and all subfolders. For a large folder this may take some time. This code is for Microsoft Windows only.

Public Sub ConvertDocToDocx()
Dim FSO, objFolder, objSubfolder, objFile, queue As Collection
Dim fldr As FileDialog
Dim strFolder As String
Dim objWordApplication As New Word.Application
Dim objWordDocument As Word.Document
Dim strOldFileName As String

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = "C:\demo\"
    If .Show <> -1 Then Exit Sub
    strFolder = .SelectedItems(1)
End With
Set fldr = Nothing

Set FSO = CreateObject("Scripting.FileSystemObject")
' magic to loop through subfolders
Set queue = New Collection
queue.Add FSO.GetFolder(strFolder)

Do While queue.Count > 0
    Set objFolder = queue(1)
    queue.Remove 1 'dequeue
    '...insert any per-folder processing code here...
    For Each objSubfolder In objFolder.SubFolders
        queue.Add objSubfolder 'enqueue
    Next objSubfolder
    
    For Each objFile In objFolder.Files
        If LCase(Right(objFile, 3)) = "doc" Then
            strOldFileName = objFile
            'Open old file
            With objWordApplication
                Set objWordDocument = .Documents.Open(FileName:=strOldFileName, AddToRecentFiles:=False, ReadOnly:=False, Visible:=True)
                ' Save it
                With objWordDocument
                    ' Save as docx or docm, depending on whether the file contains macros.
                    ' and turn off compatibility mode
                    If .HasVBProject = False Then
                    .SaveAs2 FileName:=.FullName & "x", FileFormat:=wdFormatXMLDocument, CompatibilityMode:=15, AddToRecentFiles:=False
                    Else
                    .SaveAs2 FileName:=.FullName & "m", FileFormat:=wdFormatXMLDocumentMacroEnabled, CompatibilityMode:=15, AddToRecentFiles:=False
                    End If
                    'close the document
                    .Close False
                End With
            End With

        End If
    Next objFile
Loop

End Sub

Related

KB922850 - A file type was blocked by your registry policy settings.
Convert Excel .xls to .xlsx Excel Spreadsheet Macro.