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

基本要求：需安装WORD
　　
　　FunctionWordReplace(FileNameAsString,SearchStringAsString,ReplaceStringAsString,OptionalSaveFileAsString="",OptionalMatchCaseAsBoolean=False)AsInteger
　　OnErrorGoToErrorMsg'函数运行时发生遇外或错误,转向错误提示信息
　　
　　DimwordAppAsNewWord.Application
　　DimwordDocAsNewWord.Document
　　DimwordArangeAsWord.Range
　　DimwordSelectionAsWord.Selection
　　DimReplaceSignAsBoolean
　　DimIAsInteger
　　
　　
　　'判断将要替换的文件是否存在
　　IfDir(FileName)=""Then
　　'替换文件不存在
　　MsgBox"未找到"&FileName&"文件"'提示替换文件不存在信息
　　WordReplace=-2'返回替换文件不存在的值
　　ExitFunction'退出函数
　　EndIf
　　
　　SetwordApp=CreateObject("Word.Application")'建立WORD实例
　　wordApp.Visible=False'屏蔽WORD实例窗体
　　SetwordDoc=wordApp.Documents.Open(FileName)'打开文件并赋予文件实例
　　SetwordSelection=wordApp.Selection'定位文件实例
　　SetwordArange=wordApp.ActiveDocument.Range(0,1)'指定文件编辑位置
　　wordArange.Select'激活编辑位置
　　
　　I=0'初始化替换次数值
　　ReplaceSign=True'初始化是否替换成功标志
　　DoWhileReplaceSign
　　ReplaceSign=wordArange.Find.Execute(SearchString,MatchCase,,,,,,wdFindContinue,,ReplaceString,True)'查找并替换
　　'判断查找并替换是否成功,如果成功替换次数值递增1
　　IfReplaceSign=TrueThen
　　I=I 1
　　EndIf
　　Loop
　　
　　MsgBox"已完成对文档的搜索并完成"&I&"替换。"'提示总替换次数
　　
　　'如果替换成功，则提示是否保存
　　IfI>0Then
　　'判断是否需要另存
　　IfTrim(SaveFile)<>""Then
　　'需要另存
　　IfDir(SaveFile)=""Then
　　wordDoc.SaveAsSaveFile'文件另存为……
　　Else
　　'咨询是否替换文件,如果不替换则放弃本次操作,否则存在本次操作
　　IfMsgBox("是否替换"&SaveFile&"文件？",vbYesNo vbQuestion,"替换")=vbYesThen
　　wordDoc.SaveAsSaveFile'文件另存为……
　　EndIf
　　EndIf
　　Else
　　IfMsgBox("是否保存对"&SaveFile&"更改？",vbYesNo vbQuestion,"保存")=vbYesThen
　　wordDoc.Save'保存在原文件中
　　EndIf
　　EndIf
　　EndIf
　　
　　WordReplace=I'返回替换次数
　　
　　wordDoc.Close'关闭文档实例
　　wordApp.Quit'关闭WORD实例
　　SetwordDoc=Nothing'清除文件实例
　　SetwordApp=Nothing'清除WORD实例
　　
　　
　　ExitFunction
　　
　　
　　ErrorMsg:
　　MsgBoxErr.Number&":"&Err.Description'提示错误信息
　　WordReplace=-1'返回错误信息值
　　wordDoc.Close'关闭文档实例
　　wordApp.Quit'关闭WORD实例
　　SetwordDoc=Nothing'清除文件实例
　　SetwordApp=Nothing'清除WORD实例
　　
　　EndFunction
　　
　　注意事项：单击在菜单“工程”中的“引用”菜单项，弹出窗口，在列表框中选择“MicrosoftWordXObjectLibaray“，单击引用
　　
　　在VB6.0 OfficeXP Windows测试通过->