VB查找并替换WORD文档中的字符串

Function WordReplace(FileName As String, SearchString As String, ReplaceString As String, Optional SaveFile As String = \"\Boolean = False) As Integer

On Error GoTo ErrorMsg '函数运行时发生遇外或错误,转向错误提示信息

Dim wordApp As New Word.Application Dim wordDoc As New Word.Document Dim wordArange As Word.Range

Dim wordSelection As Word.Selection Dim ReplaceSign As Boolean Dim I As Integer

'判断将要替换的文件是否存在 If Dir(FileName) = \"\" Then '替换文件不存在

MsgBox \"未找到\" amp; FileName amp; \"文件\" '提示替换文件不存在信息 WordReplace = -2 '返回替换文件不存在的值 Exit Function '退出函数 End If

Set wordApp = CreateObject(\"Word.Application\") '建立WORD实例 wordApp.Visible = False '屏蔽WORD实例窗体

Set wordDoc = wordApp.Documents.Open(FileName) '打开文件并赋予文件实例 Set wordSelection = wordApp.Selection '定位文件实例

Set wordArange = wordApp.ActiveDocument.Range(0, 1) '指定文件编辑位置 wordArange.Select '激活编辑位置

I = 0 '初始化替换次数值

ReplaceSign = True '初始化是否替换成功标志 Do While ReplaceSign

ReplaceSign = wordArange.Find.Execute(SearchString, MatchCase, , , , wdFindContinue, , ReplaceString, True) '查找并替换 '判断查找并替换是否成功,如果成功替换次数值递增1 If ReplaceSign = True Then I = I + 1 End If Loop

MsgBox \"已完成对文档的搜索并完成 \" amp; I amp; \" 替换。\" '提示总替换次数

'如果替换成功，则提示是否保存

, , If I > 0 Then '判断是否需要另存

If Trim(SaveFile) <> \"\" Then '需要另存

If Dir(SaveFile) = \"\" Then

wordDoc.SaveAs SaveFile '文件另存为„„ Else

'咨询是否替换文件,如果不替换则放弃本次操作,否则存在本次操作

If MsgBox(\"是否替换\" amp; SaveFile amp; \"文件？\替换\") = vbYes Then

wordDoc.SaveAs SaveFile '文件另存为„„ End If End If Else

If MsgBox(\"是否保存对\" amp; SaveFile amp; \"更改？\保存\") = vbYes Then

wordDoc.Save '保存在原文件中 End If End If End If

WordReplace = I '返回替换次数

wordDoc.Close '关闭文档实例 wordApp.Quit '关闭WORD实例

Set wordDoc = Nothing '清除文件实例 Set wordApp = Nothing '清除WORD实例

Exit Function

ErrorMsg:

MsgBox Err.Number amp; \":\" amp; Err.Description '提示错误信息 WordReplace = -1 '返回错误信息值 wordDoc.Close '关闭文档实例 wordApp.Quit '关闭WORD实例

Set wordDoc = Nothing '清除文件实例 Set wordApp = Nothing '清除WORD实例

End Function

注意事项：单击在菜单“工程”中的“引用”菜单项，弹出窗口，在列表框中选择“Microsoft Word X Object Libaray“，单击引用

在VB6.0+Office XP+Windows测试通过