I need to create hyperlinks from strings of text selected based on font formatting. I've created a macro that finds the string, adds a path to the beginning of the string and a .doc extension to the end (the documents don't exist now, but will be created later), and copies the revised string to the clipboard - so far, so good. However, the next part of the macro IS SUPPOSED TO open the Insert Hyperlink dialog box, paste the copied string into the 'Type the file or Web page name' text box and create the link. What happens however, is that the link that's created is always the same link (the very first link I create) regardless of the string copied.
The code is listed below. Can anyone help me to get it work correctly? Would also appreciate assistance in creating a loop to repeat the macro until it reaches the end of the document.
Thanks,
AJ
Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 10
.Bold = False
.Italic = False
.Color = 32512
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Copy
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="\"
Selection.Paste
Selection.MoveLeft Unit:=wdWord, Count:=3, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Application.Browser.Next
Selection.Copy
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Application.Browser.Next
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
"E:\Docs\A\Accessing the Internet.doc", SubAddress:="", _
ScreenTip:="", TextToDisplay:="Accessing the Internet"
The code is listed below. Can anyone help me to get it work correctly? Would also appreciate assistance in creating a loop to repeat the macro until it reaches the end of the document.
Thanks,
AJ
Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 10
.Bold = False
.Italic = False
.Color = 32512
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Copy
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="\"
Selection.Paste
Selection.MoveLeft Unit:=wdWord, Count:=3, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Application.Browser.Next
Selection.Copy
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Application.Browser.Next
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
"E:\Docs\A\Accessing the Internet.doc", SubAddress:="", _
ScreenTip:="", TextToDisplay:="Accessing the Internet"