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

基本要求：需安装WORD Function WordReplace(FileName As String, SearchString As String, ReplaceString As String, Optional SaveFile As String = , Optional MatchCase As 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; 文件？, vbYesNo + vbQuestion, 替换) = vbYes Then wordDoc.SaveAs SaveFile 文件另存为 End If End If Else If MsgBox(是否保存对 amp; SaveFile amp; 更改？, vbYesNo + vbQuestion, 保存) = 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测试通过