Vba 如何将大量文件转换为docx？

我有大量的doc文件要转换成docx文件

我发现没有一种真正好的方法可以自动进行这种转换

---

我已经提交了我用来做这件事的方法，但也许现在还有其他方法。

我发现了一些可能有用的方法：

但是，我对提供的宏不满意。我需要一些递归的东西来转换嵌套文件。所以我把它扩展成这样

Sub SaveAllAsDOCX()

    'Search #EXT to change the extensions to save to docx

    Dim strDocName As String
    Dim strPath As String
    Dim oDoc As Document
    Dim fDialog As FileDialog
    Dim intPos As Integer

    'Create a folder dialog
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = "Select root folder and click OK"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then
            MsgBox "Cancelled By User", , "List Folder Contents"
            Exit Sub
        End If

    'Select root folder
    strPath = fDialog.SelectedItems.Item(1)

    'Ensure the Folder Name ends with a "\"
    If Right(strPath, 1) <> "\" Then strPath = strPath + "\"

End With

'Close any open documents
If Documents.Count > 0 Then
    Documents.Close SaveChanges:=wdPromptToSaveChanges
End If

'remove any quotes from the folder string
If Left(strPath, 1) = Chr(34) Then
    strPath = Mid(strPath, 2, Len(strPath) - 2)
End If

'begin recusion
recurse (strPath)

End Sub

'This method controls the recusion
Function recurse(folder As String)

    'save all the files in the current folder
    SaveFilesInFolder (folder)

    'get all the subfolders of the current folder
    Dim folderArray
    folderArray = GetSubFolders(folder)

    'Loop through all the non-empty elements for folders
    For j = 1 To UBound(folderArray)
        If folderArray(j) <> "" Then
            'begin recusion on subfolder
            recurse (folder & folderArray(j) & "\")
        End If
    Next
End Function

'Saves all files with listed extensions
Function SaveFilesInFolder(folder As String)

    'List of extensions to look for #EXT
    Dim strFilename As String
    extsArray = Array("*.rtf", "*.doc")

    'Loop through extensions
    For i = 0 To (UBound(extsArray))

        'select the 1st file with the current extension
        strFilename = Dir(folder & extsArray(i), vbNormal)

        'double check the current extension (don't to resave docx files)
        Dim ext As String
        ext = ""
        On Error Resume Next
        ext = Right(strFilename, 5)

        If ext = ".docx" Or ext = "" Then
            'Don't need to resave files in docx format
    Else
        'Save the current file in docx format
        While Len(strFilename) <> 0
            Set oDoc = Documents.Open(folder & strFilename)
            strDocName = ActiveDocument.FullName
            intPos = InStrRev(strDocName, ".")
            strDocName = Left(strDocName, intPos - 1)
            strDocName = strDocName & ".docx"
            oDoc.SaveAs FileName:=strDocName, _
                FileFormat:=wdFormatDocumentDefault
            oDoc.Close SaveChanges:=wdDoNotSaveChanges

            strFilename = Dir
        Wend
    End If
    Next

    strFilename = ""
End Function

'List all the subfolders in the current folder
Function GetSubFolders(RootPath As String)
    Dim FS As New FileSystemObject
    Dim FSfolder As folder
    Dim subfolder As Variant


    Set FSfolder = FS.GetFolder(RootPath)

    'subfolders is variable length
    Dim subfolders() As String
    ReDim subfolders(1 To 10)

    Dim i As Integer
    i = LBound(subfolders)
    For Each subfolder In FSfolder.subfolders
        subfolders(i) = subfolder.Name

        'increase the size of subfolders if it's needed
        i = i + 1
        If (i >= UBound(subfolders)) Then
            ReDim subfolders(1 To (i + 10))
        End If

    Next subfolder

    Set FSfolder = Nothing

    GetSubFolders = subfolders

End Function

---

是的，我知道有很多代码

我写了一篇问答文章。只是为了让其他人在需要的时候可以使用这些信息，因为这被否决了，贡献知识应该在这里得到鼓励。。。