VB查找并替換WORD文檔中的字符串

2019-11-18 17:41:05

字體：大中小

來源：轉載

供稿：網友

基本要求：需安裝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.Descr
EndFunction

注意事項：單擊在菜單“工程”中的“引用”菜單項，彈出窗口，在列表框中選擇“MicrosoftWordXObjectLibaray“，單擊引用

在VB6.0 OfficeXP Windows測試通過->