0

我已经获得了这段非常方便的代码，它通过 excel 按钮搜索文件夹并根据 Excel 工作表的 A 列和 B 列中输入的条件对所有 Word 文档执行查找和替换，它还提供了一个 msgbox 来显示如何已找到许多文件并进行了替换循环。此代码依次打开每个 word 文档，进行查找和替换，然后保存新文档。它还输出一个文本文件以报告更改的内容和位置。但！

我的问题是与报告 txt 文件有关，目前我认为它已设置（代码称为“whatchanged”）在每次循环通过 word docs 中的 Range 'Stories' 时写一行，因此它正在写重复的行在它搜索的每个故事的报告文件中，而不是仅在一行中搜索实际找到和替换的内容。

我正在努力想一种方法使此代码输出一行，仅显示更改的内容而没有任何重复。即使没有为每个范围故事进行查找和替换，它似乎也会在文本文件上输出一行！所以不是很有用...

如果有人能提出一种使报告文本文件更整洁的好方法，我将不胜感激？- 即只报告实际的查找和替换，没有重复的行。

您可以提供的任何帮助/建议将不胜感激，请注意，我是这个论坛和 vba 的新手，所以我正在尽我所能向他人学习和研究代码。我也发布了这个，希望如果你搜索类似的东西，这个代码也对其他人有用。

顺便说一句 .. 下面是一个仅针对一个测试文档的文本文件输出示例！，抱歉，如果这不是很清楚...这是在运行代码后创建的，并在 Excel 表上输入了一些测试查找和替换 - 你可以看到我对重复的意思：

文件、查找、替换、时间

H:\Letters Test\Doc1.doc|在字母中测试文本|替换文本|15/10/2013 11:06:02
H:\Letters Test\Doc1.doc|10 月|11 月|2013 年 10 月 15 日 11:06 :02
H:\Letters Test\Doc1.doc|VBA 测试员先生|Ms 测试|15/10/2013 11:06:02
H:\Letters Test\Doc1.doc|2013|2014|15/10/2013 11: 06:02
H:\Letters Test\Doc1.doc|诚挚的|真诚的|2013 年 10 月 15 日 11:06:02
H:\Letters Test\Doc1.doc|在信中测试文本|替换文本|15/10 /2013 11:06:02
H:\Letters Test\Doc1.doc|10 月|11 月|15/10/2013 11:06:02
H:\Letters Test\Doc1.doc|Mr VBA 测试员|Ms 测试|15/ 10/2013 11:06:02
H:\Letters Test\Doc1.doc|2013|2014|15/10/2013 11:06:02
H:\Letters Test\Doc1.doc|诚挚的|真诚的|15/ 10/2013 11:06:03
H:\Letters Test\Doc1.doc|在信中测试文本|替换文本|15/10/2013 11:06:03
H:\Letters Test\Doc1.doc|10 月|11 月|15/10/2013 11:06 :03
H:\Letters Test\Doc1.doc|VBA 测试员先生|Ms 测试|15/10/2013 11:06:03
H:\Letters Test\Doc1.doc|2013|2014|15/10/2013 11: 06:03
H:\Letters Test\Doc1.doc|诚挚的|真诚的|2013 年 10 月 15 日 11:06:03
H:\Letters Test\Doc1.doc|在信中测试文本|替换文本|15/10 /2013 11:06:03
H:\Letters Test\Doc1.doc|10 月|11 月|15/10/2013 11:06:04
H:\Letters Test\Doc1.doc|Mr VBA 测试员|Ms 测试|15/ 10/2013 11:06:04
H:\Letters Test\Doc1.doc|2013|2014|15/10/2013 11:06:04
H:\Letters Test\Doc1.doc|诚挚的|诚挚的|15/ 10/2013 11:06:04
H:\Letters Test\Doc1.doc|测试字母中的文本|替换文本|15/10/2013 11:06:04
H:\Letters Test\Doc1.doc|10 月|11 月|2013 年 10 月 15 日 11:06 :04
H:\Letters Test\Doc1.doc|VBA 测试员先生|Ms 测试|15/10/2013 11:06:04
H:\Letters Test\Doc1.doc|2013|2014|15/10/2013 11: 06:04
H:\Letters Test\Doc1.doc|诚挚的|真诚的|2013 年 10 月 15 日 11:06:04
H:\Letters Test\Doc1.doc|在信中测试文本|替换文本|15/10 /2013 11:06:04
H:\Letters Test\Doc1.doc|10 月|11 月|15/10/2013 11:06:04
H:\Letters Test\Doc1.doc|Mr VBA 测试员|Ms 测试|15/ 10/2013 11:06:04
H:\Letters Test\Doc1.doc|2013|2014|15/10/2013 11:06:04
H:\Letters Test\Doc1.doc|诚挚的|诚挚的|15/ 10/2013 11:06:05
H:\Letters Test\Doc1.doc|在信中测试文本|替换文本|15/10/2013 11:06:05
H:\Letters Test\Doc1.doc|10 月|11 月|15/10/2013 11:06 :05
H:\Letters Test\Doc1.doc|VBA 测试员先生|Ms 测试|15/10/2013 11:06:05
H:\Letters Test\Doc1.doc|2013|2014|15/10/2013 11: 06:05
H:\Letters Test\Doc1.doc|诚挚的|真诚的|2013 年 10 月 15 日 11:06:05

代码：

'~~> Defining Word Constants
Const wdFindContinue As Long = 1
Const wdReplaceAll As Long = 2

Public FileNum As Integer
Public OutputTxt As String


Sub WordReplace(sFolder, savePath)
Dim oWordApp As Object, oWordDoc As Object, rngStory As Object
Dim strFilePattern As String
Dim strFileName As String, sFileName As String
Dim rngXL As Range
Dim x As Range
Dim strFind As String
Dim strReplace As String
Dim whatChanged As String

'~~> This is the extention you want to go in for
strFilePattern = "*.do*"

'~~> Establish an Word application object
On Error Resume Next
Set oWordApp = GetObject(, "Word.Application")

If Err.Number <> 0 Then
    Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0

oWordApp.Visible = True

'~~> Loop through the folder to get the word files
  
strFileName = Dir$(sFolder & "\" & strFilePattern)


whatChanged = "File, Find, Replacement, Time" & vbCrLf
Print #FileNum, whatChanged

Dim i, j
    i = 0 ' count of files found
    j = 0 ' count of files that matched

Do Until strFileName = ""
    
    i = i + 1
    
    sFileName = sFolder & "\" & strFileName

    '~~> Open the word doc
    Set oWordDoc = oWordApp.Documents.Open(sFileName)
    Set rngXL = Sheets(1).Range("A2:A" & Range("A2").End(xlDown).Row)
   
    '~~> Do Find and Replace
    For Each rngStory In oWordDoc.StoryRanges
       
        For Each x In rngXL
            strFind = x.Value
            strReplace = x.Offset(0, 1).Value
            j = j + 1
            With rngStory.Find
                .text = strFind
                .Replacement.text = strReplace
                .Wrap = wdFindContinue
                .Execute Replace:=wdReplaceAll
            End With
           whatChanged = sFileName & "|" & strFind & "|" & strReplace & "|" & Now()
           Print #FileNum, whatChanged
        Next
       
    Next

    '~~> Close the file after saving
    oWordDoc.Close SaveChanges:=True

    '~~> Find next file
    strFileName = Dir$()
Loop

'Call writeToFile(whatChanged, savePath)

MsgBox ("Found " & i & " files and " & j & " replacements made")

'~~> Quit and clean up
oWordApp.Quit

Set oWordDoc = Nothing
Set oWordApp = Nothing

End Sub

Sub writeToFile(text, path)
Set objFso = CreateObject("Scripting.FileSystemObject")

Dim objTextStream
Set objTextStream = objFso.OpenTextFile(path, 8, True)

'Display the contents of the text file
objTextStream.WriteLine text

'Close the file and clean up
objTextStream.Close
Set objTextStream = Nothing
Set objFso = Nothing
End Sub


Private Sub Button1_Click()
Dim objFileClass As FileClass
Set objFileClass = New FileClass

Dim searchPath, savePath
searchPath = objFileClass.SelectFolder
 
FileNum = FreeFile

OutputTxt = searchPath & "\FindAndReplaceAuditFile.TXT"

Open OutputTxt For Output As FileNum

Call WordReplace(searchPath, savePath)

Close #FileNum

End Sub
4

2 回答 2

0

Find.Execute方法在成功时返回布尔值。所以只有替换成功后才能写日志行：

With rngStory.Find
  .text = strFind
  .Replacement.text = strReplace
  .Wrap = wdFindContinue
  If .Execute(Replace:=wdReplaceAll) Then
    whatChanged = sFileName & "|" & strFind & "|" & strReplace & "|" & Now()
    Print #FileNum, whatChanged
  End If
End With
于 2013-10-16T12:19:03.950 回答
0

我看到两个选项：

1）在将字符串写入文件之前编写条件；
2）您在文件上执行一些 VBA 以过滤重复的字符串。

考虑到第一个选项，您可以采用以下几种方法：

1）读取文件并将新字符串与文件中已有的字符串进行比较：但这需要很长时间；
2）将先前的字符串存储在数组中并检查新字符串是否已经在数组中：这会更快，因为该过程发生在内存中；
3）如果搜索字符串的长度可以接受，我个人会使用字典。字典具有可以存储键值对记录的结构。
字典有一个典型的Exists方法来检查结构中是否已经存在某个键。我不认为这个键允许空格，但你可以用下划线替换这些空格。
在这种情况下，您会将每个搜索字符串作为键存储在字典中，条件是键（搜索字符串）尚不存在。

字典的结构：

Dim dict As New Scripting.Dictionary 
dim sFind_value as string
dim sKey as string    
dim sValue as string

sFind_value = trim("whatever value")
sKey = replace(sFind_value, " ", "_")
sValue = "whatever"

If Not dict.Exists(sKey) Then 
    dict.Add sKey, sValue
    'Write to file
End If

让我知道这是否有帮助，或者您是否需要有关该主题的更多帮助。

于 2013-10-16T12:20:53.777 回答