首页 > 解决方案 > 尝试使用通配符进行查找/替换

问题描述

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

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

标签: excelvba

解决方案


当然,这不是“尝试使用通配符进行查找/替换”的答案,对于您这样的专家来说,这可能看起来很粗鲁和幼稚。但它已经过尝试并使用示例数据,因此请不要标记或拒绝投票。

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

推荐阅读