Excel VBA宏，在Word文檔中查找和替換文本，輸出文本文件

我已經收穫了這個非常方便的一段代碼，它通過excel按鈕搜索文件夾並執行查找並替換所有單詞文檔，具體取決於標準輸入Excel工作表的A列和B列，它還提供了一個msgbox來顯示找到了多少個文件並且創建了替換循環。該代碼依次打開每個文件文件，進行查找和替換，然後保存新文件。它還輸出一個文本文件來報告發生了什麼變化以及在哪裏。但！Excel VBA宏，在Word文檔中查找和替換文本，輸出文本文件

我的問題是關於那個報告的txt文件，目前我認爲它被設置（代碼稱爲'whatchanged'）每次它在word docs內的範圍'故事'中循環時寫一行，它是因此在它搜索的每個故事的報道文件上寫入重複行，而不是僅僅一行，以查找實際發現和替換的內容。

我在努力想辦法讓這段代碼只輸出一行來顯示沒有任何重複的內容。它也似乎在文本文件上輸出一行，即使沒有查找和替換每個範圍故事！所以不是非常有用...

如果有人能夠提出一個好的方法來使報告文本文件更整潔，我將不勝感激。 - 即只報告實際發現和替換，沒有重複的行。

你可以給任何幫助/建議將非常感激，請注意，我是新來這個論壇和vba，所以我盡我所能向他人學習和研究代碼，因爲我去。我也發佈這個希望這個代碼可能對別人有用，如果你尋找類似的東西。

btw ..下面是一個測試文檔輸出文本文件的例子！，對不起，如果這不是非常清楚......這是在運行代碼後通過一些測試找到並替換輸入的Excel工作表 - 你能明白我的意思大概重複：

文件，查找，替換，時間

H：\快報測試\ Doc1.doc的|測試文本信|替換文本| 15/10/2013 11:06:02
H：\ Letters Test \ Doc1.doc | October | November | 15/10/2013 11:06:02
H：\ L etters Test \ Doc1.doc | Mr VBA Tester | Ms Testing | 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: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 Tester | Ms Testing | 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 | Mr VBA測試員| Ms Testing | 2013年10月10日11:06:03
H：\ Letters Test \ Doc1.doc | 2013 | 2014 | 15/10/2013 11:06:03
H：\ Letters Test \ Doc1.doc |您誠摯的|您的忠實| 15/10/2013 11:06:03
H：\ Letters Test \ Doc1。DOC |測試文本信|替換文本| 15/10/2013 11時06分03秒
H：\快報測試\ Doc1.doc的|十月|十一月| 15/10/2013 11:06:04
H： \快報測試\ Doc1.doc的|先生VBA測試儀|小姐測試| 15/10/2013 11:06:04
H：\快報測試\ 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 | October | November | 15/10/2013 11:06:04
H：\ Letters Test \ Doc1.doc | Mr VBA Tester | Ms Testing | 15/10/2013 11:06:04
H：\快報測試\ Doc1.doc的| 2013 | 2014 | 15/10/2013 11:06:04
H：\快報測試\ Doc1.doc的|此致|此致| 15/10/2013 11 ：06：04
H：\ Letters Test \ Doc1.doc |測試文本中的字母|替換文本| 15/10/2013 11:06:04
H：\ Letters Test \ Doc1.doc | October | November | 2013年10月15日下午11:06:04
H：\ Letters Test \ Doc1.doc | 2013 | 2013 | 15/10/2013 11:06:04
H：\ Letters Test \ Doc1.doc |您誠摯的|您的忠實| 15/10/2013 11:06:05
H：\字母測試\ Doc1.doc |以字母測試文本| Replacem耳鼻喉科文字| 15/10/2013 11時06分05秒
H：\快報測試\ Doc1.doc的|十月|十一月| 15/10/2013 11時06分05秒
H：\快報測試\ Doc1.doc的| Mr VBA Tester | Ms Testing | 15/10/2013 11:06:05
H：\ Letters Test \ Doc1.doc | 2013 | 2014 | 15/10/2013 11:06:05
H：\ Letters測試\ Doc1.doc的|此致|此致| 15/10/2013 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

來源

2013-10-16 Alex H

的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-16 12:19:03

感謝羅馬，我剛剛試過這個方法，並得到了一個編譯錯誤，無效/不合格的引用.execute。 –

.Execute必須在_With_ block中，可能是錯誤。我編輯了代碼片段。 –

非常感謝，是的，這是什麼原因造成的問題...我修改了代碼，重新運行宏，生成的文本文件看起來好多了！謝謝。 –

我看到兩個選項：

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-16 12:20:53 Trace

非常感謝這個Kim，我會考慮這些選項！ –

Excel VBA宏，在Word文檔中查找和替換文本，輸出文本文件

回答

相關問題