On Error Resume Next
SrcDir = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\")-1)
ListFile = SrcDir & "\替换内容集.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFile = fso.OpenTextFile(ListFile,1)

Do Until objFile.AtEndofStream
    strLine = objFile.ReadLine
    If InStr(strLine,"，") Then
        ReDim PreServe ar(1,i)
        ar(0,i)=Split(strLine,"，")(0) : ar(1,i)=Split(strLine,"，")(1)
        i = i + 1
    End If
Loop

GetSubFolder SrcDir

Sub GetSubFolder(SubFolder)
    For Each file in fso.GetFolder(SubFolder).Files
        If LCase(Right(file,4)) = ".txt" Then
            If Not LCase(file) = LCase(ListFile) Then
                WriteToFile file,"UTF-8"
            End If
        End If
    Next
    For Each folder in fso.GetFolder(SubFolder).SubFolders
        GetSubFolder folder
    Next
End Sub

Sub WriteToFile(file,CharSet)
    With CreateObject("Adodb.Stream")
        .Type = 2
        .Mode = 3
        .CharSet = CharSet
        .Open
        .LoadFromFile file
        text = .Readtext
        For j = 0 to i - 1
            text = RePlace(text,ar(0,j),ar(1,j))
        Next
        .Position = 0
        .CharSet = CharSet
        .WriteText text
        .SetEOS
        .SaveToFile file,2
        .Close
    End With
End Sub
复制代码