Question

我设法修改了这个VBA脚本，以便它能够选择一个文件夹，将.RTF转换为.DOCX，并在转换后删除.RTF文件。我无法弄清楚的是，如何让脚本也转换该文件夹中的子文件夹。我已经在线查看，但无法找到解决方案。请指教。

Sub ChangeRTFTODOCXOrTxtOrRTFOrHTML()

    Dim fs As Object
    Dim oFolder As Object
    Dim tFolder As Object
    Dim oFile As Object
    Dim strDocName As String
    Dim intPos As Integer
    Dim folderDialog As FileDialog
    Dim fileType As String
    Dim locFolderKill As String

    Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker)
    folderDialog.AllowMultiSelect = False
    folderDialog.Show

    Debug.Print folderDialog.SelectedItems(1)

    Select Case Application.Version
        Case Is < 12
            Do
                fileType = UCase(InputBox("Change rtf to TXT, RTF, HTML, DOCX", "File Conversion", "DOCX"))
            Loop Until (fileType = "TXT" Or fileType = "RTF" Or fileType = "HTML" Or fileType = "DOCX")
        Case Is >= 12
            Do
                fileType = UCase(InputBox("Change rtf to TXT, RTF, HTML, DOCX or PDF(2007+ only)", "File Conversion", "DOCX"))
            Loop Until (fileType = "TXT" Or fileType = "RTF" Or fileType = "HTML" Or fileType = "PDF" Or fileType = "DOCX")
    End Select
    Application.ScreenUpdating = False
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set oFolder = fs.GetFolder(folderDialog.SelectedItems(1))
        For Each oFile In oFolder.Files
        Dim d As Document
        Set d = Application.Documents.Open(oFile.Path)
        strDocName = ActiveDocument.Name
        intPos = InStrRev(strDocName, ".")
        strDocName = Left(strDocName, intPos - 1)
        ChangeFileOpenDirectory oFolder
        Select Case fileType
        Case Is = "DOCX"
            strDocName = strDocName & ".DOCX"
            ActiveDocument.SaveAs FileName:=strDocName, FileFormat:=wdFormatXMLDocument
        Case Is = "TXT"
            strDocName = strDocName & ".txt"
            ActiveDocument.SaveAs FileName:=strDocName, FileFormat:=wdFormatText
        Case Is = "RTF"
            strDocName = strDocName & ".rtf"
            ActiveDocument.SaveAs FileName:=strDocName, FileFormat:=wdFormatRTF
        Case Is = "HTML"
            strDocName = strDocName & ".html"
            ActiveDocument.SaveAs FileName:=strDocName, FileFormat:=wdFormatFilteredHTML
        Case Is = "PDF"
            strDocName = strDocName & ".pdf"

        End Select
        d.Close
        ChangeFileOpenDirectory oFolder
    Next oFile
    Application.ScreenUpdating = True

'This will delete the .RFT files in the same folder.
    Kill "*.rtf"

End Sub

Answer 1

以下是检查子文件夹的示例 - 您可以通过循环遍历从GetFileMatches

返回的集合将其合并到现有代码中

Sub Tester()

    Dim col As Collection, f

    Set col = GetFileMatches("C:\_Stuff\test\", "*.TXT")

    For Each f In col
        Debug.Print f.Path
    Next f

End Sub

'Return a collection of file objects given a starting folder and a file pattern
'  e.g. "*.txt"
'Pass False for last parameter if don't want to check subfolders
Function GetFileMatches(startFolder As String, filePattern As String, _
                    Optional subFolders As Boolean = True) As Collection

    Dim fso, fldr, f, subFldr
    Dim colFiles As New Collection
    Dim colSub As New Collection

    Set fso = CreateObject("scripting.filesystemobject")
    colSub.Add startFolder

    Do While colSub.Count > 0

        Set fldr = fso.getfolder(colSub(1))
        colSub.Remove 1

        For Each f In fldr.Files
            If UCase(f.Name) Like UCase(filePattern) Then colFiles.Add f
        Next f

        If subFolders Then
            For Each subFldr In fldr.subFolders
                colSub.Add subFldr.Path
            Next subFldr
        End If

    Loop

    Set GetFileMatches = colFiles

End Function

将.rtf从所选文件夹及其子文件夹转换为.docx

1 个答案: