word vba遍历文件，打开另外word修改保存

处理完数个word，回头一看，才发现前面代码把一个符号搞反了。。。

把大于等于与小于等于两符号，颠倒了位置。。。晕。

马上用vba处理一下。

把这些word放在D盘根目录。逐个遍历并打开，逐一修改保存退出。OK！

代码如下：

Sub a()
    Dim doc As Document, myFile As String
    Dim a As Range
    
    myFile = Dir("D:\" & "*.docx")
    
    Do While myFile <> ""
        myFile = "D:\" & myFile
        Set doc = Documents.Open(myFile)
        Set a = doc.Range


        Selection.WholeStory
        '展开域
        Selection.Fields.ToggleShowCodes
        '≥≤ 把大换小，把小换小
        a.Find.Execute FindText:="≤", MatchWildcards:=True, replacewith:="$", Replace:=wdReplaceAll
        a.Find.Execute FindText:="≥", MatchWildcards:=True, replacewith:="#", Replace:=wdReplaceAll
        a.Find.Execute FindText:="$", MatchWildcards:=True, replacewith:="≥", Replace:=wdReplaceAll
        a.Find.Execute FindText:="#", MatchWildcards:=True, replacewith:="≤", Replace:=wdReplaceAll
        Selection.WholeStory
        Selection.Fields.ToggleShowCodes
        
        '保存退出
        doc.Save
        doc.Close
        
        Set doc = Nothing
        
        '查找下一个
        myFile = Dir
    Loop
End Sub

Sub a()
    Dim doc As Document, myFile As String
    Dim a As Range
    
    myFile = Dir("D:\" & "*.docx")
    Do While myFile <> ""
        myFile = "D:\" & myFile
        Set doc = Documents.Open(myFile)
        Set a = doc.Range
        
        Selection.WholeStory
        '展开域
        Selection.Fields.ToggleShowCodes
        '域调整
        a.Find.Execute FindText:="\s( ,", MatchWildcards:=False, replacewith:="\s\do6(", Replace:=wdReplaceAll
        a.Find.Execute FindText:="\s(", MatchWildcards:=False, replacewith:="\s\up7(", Replace:=wdReplaceAll
        Selection.WholeStory
        Selection.Fields.ToggleShowCodes
        
        Dim c As Range, strText As String
        '下标用域
        For Each c In a.Characters
            If c.Font.Subscript = True Then
                c.Select
                strText = Replace(c.Text, Chr(13), "")
                If strText <> "" Then
                    c.Delete
                    Set myfield = Selection.Fields.Add(Range:=Selection.Range, Type:=wdFieldEmpty, PreserveFormatting:=True) '增加一个新域
                    myfield.Code.Text = "eq \s\do4(" & strText & ")"
                Else
                    c.Font.Subscript = False
                End If
            End If
        Next
        
        '保存退出
        doc.Save
        doc.Close
        Set doc = Nothing
        '查找下一个
        myFile = Dir
    Loop
End Sub