Sub SaveAsXML()
Dim fDialog As FileDialog
Dim oDoc As Document
Dim strPath As String
Dim strFile As String
Const strNewPath As String = "C:\Path\"
Dim strName As String
    On Error GoTo err_Handler
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = "Select folder and click OK"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then
            MsgBox "Cancelled By User", , "List Folder Contents"
            GoTo lbl_Exit
        End If
        strPath = fDialog.SelectedItems.Item(1)
        If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    End With
    If Documents.Count > 0 Then
        Documents.Close SaveChanges:=wdPromptToSaveChanges
    End If
    strFile = Dir$(strPath & "*.doc")
    While strFile <> ""
        Set oDoc = Documents.Open(strPath & strFile)
        strName = Left(oDoc.name, Len(oDoc.name) - InStrRev(oDoc.name, Chr(46))) & ".xml"
        oDoc.SaveAs2 Filename:=strNewPath & strName, FileFormat:=wdFormatXML, AddToRecentFiles:=False
        oDoc.Close 0
        strFile = Dir$()
    Wend
lbl_Exit:
    Exit Sub
err_Handler:
    Err.Clear
    GoTo lbl_Exit
End Sub