Soft returns macro

问题

How do I modify the following Word macro to convert soft returns to hard returns and process all files in subfolders as well using "new file" as an event trigger?

Sub ConvertReturns()
'This Sub loops through docx files in a folder, opens each file, finds manual line breaks, replaces each with a paragraph return, saves changed file to a new folder, closes original file.
Dim oSourceFolder, oTargetFolder, oDocName As String
Dim oDoc As Document
Dim oRng As Range

'Set paths to folders for original and converted files on user's hard drive.
oSourceFolder = "C:\Users\Administrator\Desktop\Unprocessed\"
oTargetFolder = "C:\Users\Administrator\Desktop\Processed\"

'Get a handle on the first file in the source folder
oFile = Dir(oSourceFolder & "*.doc")

'Continue doing the following steps until there are no more unprocessed files in the source folder
Do While oFile <> ""
    'Open the file
    Set oDoc = Documents.Open(FileName:=oSourceFolder & oFile)
    'Get the name of the document you just opened
    oDocName = Left(oDoc.Name, Len(oDoc.Name) - 3)

    'Find all manual line breaks and replace them with paragraph markers
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .Text = "^l"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
    End With
    oRng.Find.Execute Replace:=wdReplaceAll

    'Save the changed document with the same name but appended with "_Converted" in your target folder
    oDoc.SaveAs oTargetFolder & oDocName & "doc"

    'Close the original document without saving changes
    oDoc.Close SaveChanges:=False

    'Get a handle on the next file in your source folder
    oFile = Dir

Loop

End Sub

回答1:

I personally prefer to work with the Scripting.FileSystemObject; it's generally easier to work with than parsing and recombining the output of the VBA Dir function. Add a reference to the Microsoft Scripting Runtime library, via Tools -> References....

I would suggest using the following functions :

Public Function GetFiles(ByVal roots As Variant) As Collection
    Select Case TypeName(roots)
        Case "String", "Folder"
            roots = Array(roots)
    End Select

    Dim results As New Collection
    Dim fso As New Scripting.FileSystemObject

    Dim root As Variant
    For Each root In roots
        AddFilesFromFolder fso.GetFolder(root), results
    Next

    Set GetFiles = results
End Function

Private Sub AddFilesFromFolder(folder As Scripting.folder, results As Collection)
    Dim file As Scripting.file
    For Each file In folder.Files
        results.Add file
    Next

    Dim subfolder As Scripting.folder
    For Each subfolder In folder.SubFolders
        AddFilesFromFolder subfolder, results
    Next
End Sub

This takes a path, or a Scripting.Folder object (or an array of either), and returns a collection of File objects for each file in all the subfolders for the passed in folder(s).

Then you can write your code as follows:

Sub ConvertReturns()
    'This Sub loops through docx files in a folder recursively, opens each file, finds manual line breaks, replaces each with a paragraph return, saves changed file to a new folder, closes original file.

    Dim targetFolder As String
    Dim oFile As Scripting.file, oFso As New Scripting.FileSystemObject
    Dim oDoc As Document, oRng As Range
    Dim fileName As String, fileExtension As String
    Dim targetPath As String

    'Set paths to folders for original and converted files on user's hard drive.
    Const sourceFolder = "C:\Users\Administrator\Desktop\Unprocessed\"
    targetFolder = "C:\Users\Administrator\Desktop\Processed\"

    'Repeat the following code for each File object in the Collection returned by GetFiles
    For Each oFile In GetFiles(sourceFolder)
        'This handles any Word Document -- .doc and .docx
        If oFile.Type Like "Microsoft Word*" Then
            'Open the file
            '.Path returns the full path of the file
            Set oDoc = Documents.Open(fileName:=oFile.Path)

            'Find all manual line breaks and replace them with paragraph markers
            Set oRng = ActiveDocument.Range
            With oRng.Find
                .Text = "^l"
                .Replacement.Text = "^p"
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
            End With
            oRng.Find.Execute Replace:=wdReplaceAll

            fileName = oFso.GetBaseName(oFile.Name)
            fileExtension = oFso.GetExtensionName(oFile.Name)
            targetPath = oFso.BuildPath(targetFolder, fileName & "_Converted." & fileExtension)

            'Save the changed document with the same name but appended with "_Converted" in your target folder
            oDoc.SaveAs targetPath

            'Close the original document without saving changes
            oDoc.Close SaveChanges:=False
        End If
    Next
End Sub

---

References:

Scripting Runtime

• FileSystemObject object
  • GetBaseName method
  • GetExtensionName method
  • BuildPath method
• File object
  • Type property

Word object model

• Global ActiveDocument property
• Application object
  • Documents property
• Documents collection
  • Open method
• Document object
  • Range method
  • SaveAs2 method
  • Close method
• Range object
  • Find method
• Find object
  • Text property
  • Format, Wrap, Forward, MatchCase properties
  • Replacement property
  • Execute method
• Replacement object,
  • Text property

VBA

• TypeName function
• Array function
• Collection object
  • Add method
• Like operator

来源：https://stackoverflow.com/questions/51178997/soft-returns-macro