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