Question

我试图遍历文件夹中的所有文本文件，打开每个文本文件，进行查找/替换，保存每个文本文件，然后关闭每个文本文件。我的代码看起来像这样。

Sub FindAndReplaceText()

 Dim FileName As String
 Dim FolderPath As String
 Dim FSO As Object
 Dim I As Integer
 Dim SearchForWords As Variant
 Dim SubstituteWords As Variant
 Dim Text As String
 Dim TextFile As Object

  'Change these arrays to word you want to find and replace
  SearchForWords = Array("  steps:" & "*" & "        fields:")
  SubstituteWords = Array("  global" & vbCrLf & "    global:" & vbCrLf & "      schema_def:" & vbCrLf & "        fields:")

  'Change the folder path to where your text files are.
  ' look for all lines with: '      - .*Pricing_RealEstate' & '*'
   FolderPath = "C:\path_here\"

     Set FSO = CreateObject("Scripting.FileSystemObject")

     FolderPath = IIf(Right(FolderPath, 1) <> "\", FolderPath & "\", FolderPath)
     FileName = Dir(FolderPath & "\*.txt")

     Do While FileName <> ""
       FileSpec = FolderPath & FileName
        'Read all the file's text into a string variable.
         Set TextFile = FSO.OpenTextFile(FileSpec, 1, False)
           Text = TextFile.ReadAll
         TextFile.Close

        'Scan the string for words to replace and write the string back to the file.
         Set TextFile = FSO.OpenTextFile(FileSpec, 2, False)
           For I = 0 To UBound(SearchForWords)
           Debug.Print Text
             Replace Text, SearchForWords(I), SubstituteWords(I)
           Debug.Print Text
           Next I
         TextFile.Write Text
         TextFile.Close
       FileName = Dir()
     Loop

End Sub

Answer 1

当然，这不是“尝试用通配符进行查找/替换”的答案，对于您的身材专家而言，可能看起来像是粗鲁而幼稚的。但这是经过尝试并与示例数据一起使用的，因此请不要进行标记或投反对票。

Sub FindAndReplaceText2()
 Dim FileName, FileName2 As String
 Dim FolderPath, FolderPath2 As String
 Dim FileSpec, FileSpec2 As String
 Dim FSO As Object
 Dim SearchForWords As String
 Dim SubstituteWords As String
 Dim Text As String
 Dim TextFile As Object

  'Change these arrays to word you want to find and replace
  SearchForWords = "  steps:" & "*" & "        fields:"
  SubstituteWords = "  global" & vbCrLf & "    global:" & vbCrLf & "      schema_def:" & vbCrLf & "        fields:"


  'Change the folder path to where your text files are.
  ' look for all lines with: '      - .*Pricing_RealEstate' & '*'
   FolderPath = "C:\users\user\Desktop\New Folder\"
   FolderPath2 = "C:\users\user\Desktop\New Folder2\"
   Set FSO = CreateObject("Scripting.FileSystemObject")
   FileName = Dir(FolderPath & "\*.txt")

     Do While FileName <> ""
       FileSpec = FolderPath & FileName
       FileSpec2 = FolderPath2 & FileName

        'Read all the file's text into a string variable.
         Set TextFile = FSO.OpenTextFile(FileSpec, 1, False)
         Text = TextFile.ReadAll
         TextFile.Close
         'SrchReplText Now  work for single wildcard only
         Text = SrchReplText(Text, SearchForWords, SubstituteWords)
        'Scan the string for words to replace and write the string back to the file.
         Set TextFile = FSO.CreateTextFile(FileSpec2, 2, False)
         TextFile.Write Text
         TextFile.Close
     FileName = Dir()
     Loop
End Sub

Private Function SrchReplText(Txt As String, SrcTxt As String, RplTxt As String) As Variant
'Now for single wildcard only using single loop
Dim Wordx, Word3 As Variant
Dim I, I2 As Long
SrchReplText = Txt
Wordx = Split(SrcTxt, "*")
If UBound(Wordx) > 1 Then Exit Function
If UBound(Wordx) = 1 Then
Do
  Found = False
  I = InStr(1, SrchReplText, Wordx(0))
  If I > 0 Then I2 = InStr(I, SrchReplText, Wordx(1))
     If I > 0 And I2 > 0 Then
     Found = True
     Word3 = Mid(SrchReplText, I, I2 - I + Len(Wordx(1)))
     SrchReplText = Replace(SrchReplText, Word3, RplTxt, 1, 1)
     End If
Loop While Found
Else
SrchReplText = Replace(SrchReplText, SrcTxt, RplTxt, 1, 1)
End If
End Function

尝试使用通配符进行查找/替换

1 个答案: