Find Text and Add Hyperlink

[Bullracer2]

Hi,
I was wondering if someone is able to provide some guidance on how to achieve the following programmatically:

I have some large word documents (and there are a few hundred of them) which contain some specific text. I want to have a hyperlink added to this specific text (not the text changed). I.e. "ABC" converted to have a hyperlink to w w w . microsoft.c o m, "XYZ" converted to have a hyperlink of w w w. google.c o m, there are about two dozen in total instances of different text.

Any assistance would be greatly appreciated.

Thanks,

[macropod]

Try something along the lines of:
Sub AddDocumentHyperlinks()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
Dim FndArray As Variant, RepArray As Variant
FndArray = Array("ABC", "XYZ")
RepArray = Array("www.microsoft.com (http://www.microsoft.com)", "www.google.com (http://www.google.com)")
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
For i = LBound(FndArray) To UBound(FndArray)
With wdDoc.Content
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = FndArray(i)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found = True
.Duplicate.Hyperlinks.Add Anchor:=.Duplicate, Address:=RepArray(i), _
SubAddress:="", ScreenTip:="", TextToDisplay:=FndArray(i)
.Start = .Duplicate.Hyperlinks(1).Range.End
.Find.Execute
Loop
End With
Next
wdDoc.Close SaveChanges:=True
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

[Bullracer2]

Thanks so much, That is even better than what i was looking for (was content to open each document individually).
One small issue (which i haven't spent ahuge amount of time trying to solve) is that the hyperlink on mouse over is showing the path as follows file:///c:\users\user\documents\ w w w.microsoft.com (on clicking doesn't work). When i right click and try and edit the hyperlink manually it is showing as w w w.micrsoft.com
I'm sure it's only something minor...

Thanks again

[macropod]

When I run the code, I don't get the 'file:///c:\users\user\documents\' prefix. Probably all you need to do is to change:
RepArray = Array("www.microsoft.com (http://www.microsoft.com/)", "www.google.com (http://www.google.com/)")
to:
RepArray = Array("http://www.microsoft.com (http://www.microsoft.com/)", "http://www.google.com (http://www.google.com)")

[Bullracer2]

Thanks Paul sorted it out. Once i saved it as a macro template it was all good rather than just in an unsaved word document.

Final question (been trolling through these forums for the past few hours) is around the syntax for wildcards in the array component. Within the document there may be instances where instead of the text just being "ABC" it may be "ABC.10" "ABC.50", etc.

In the with loop i've added the MatchWildcards = True and within FndArray = Array ("ABC*") and a few other variations without success. Are you able to assist with how it should look?

Thanks,

[macropod]

The simplest way of dealing with such cases is to add the corresponding entries for them to both arrays - before the plain 'ABC' entry.

Alternatively, you could use:
FndArray = Array("<ABC.[0-9]{1,}>", "<ABC>", "<XYZ>")
RepArray = Array("www.microsoft.com (http://www.microsoft.com/)", ("www.microsoft.com (http://www.microsoft.com/)", "www.google.com (http://www.google.com/)")

and replace:
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
with:
.MatchWildcards = True