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测试通过->
文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!
