Hi all,
I am trying to update hyperlink bookmarks for each word document in a folder.
Found a similar post
here but find and replace doesn't work in my case.
Using this related code, I modified to find and replace all hyperlinks in the word doc but it seems no hyperlink has been updated in the new file when macro is run.
Secondly, not sure if it is possible to save as current file instead of output as new file.
Appreciate if you could share similar resource or help to review my code.
Thanks in advance!
Regards
Hidayat
Code:
Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strInFolder As String, strOutFold As String, strFile As String, wdDoc As Document
strInFolder = GetFolder
If strInFolder = "" Then Exit Sub
strFile = Dir(strInFolder & "\*.doc*", vbNormal)
'Check for documents in the folder - exit if none found
If strFile <> "" Then strOutFold = strInFolder & "\Output\"
'Test for an existing outpfolder & create one if it doesn't already exist
If Dir(strOutFold, vbDirectory) = "" Then MkDir strOutFold
strFile = Dir(strInFolder & "\*.doc*", vbNormal)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strInFolder & "\" & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
With wdDoc
ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
Selection.Find.Replacement.ClearFormatting
With Selection.Find
'Old hyperlink
.Text = _
"www.yahoo.com"
'New Hyperlink
.Replacement.Text = _
"www.google.com"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.CorrectHangulEndings = True
.HanjaPhoneticHangul = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
'Save and close the document
.SaveAs FileName:=strOutFold & .Name, AddToRecentFiles:=False
.Close
End With
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function