基本要求：需安裝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測試通過->
