How to extract selected hyperlink address to clipboard?

[poetofpiano]

I am trying to copy the address (not the display text) of the currently selected hyperlinked text in a word document. However, I am sort of new at this and all my research hasn't led to a definitive method.

I see this question has been asked before at https://stackoverflow.com/questions/...-links-address but the answer offered there is not working for me, and in any case, I would prefer to just use a more current method for Word 2016, and I'm assuming what I want can be done without adding a legacy form library and just using the Hyperlink.Address Property detailed at https://msdn.microsoft.com/en-us/vba...-property-word

Any help would be very appreciated!

[macropod]

Try:

Sub CopyHyperlink()
Dim Rng As Range
Set Rng = Selection.Hyperlinks(1).Range.Fields(1).Code
With Rng
  .MoveStartUntil Chr(34), wdForward
  .Start = .Start + 1
  .Collapse wdCollapseStart
  .MoveEndUntil Chr(34), wdForward
  .Copy
End With
End Sub

[poetofpiano]

Thank you for your help macropod. Because your version only copied the name of the bookmark instead of the full file path, I used a simplified version of your suggestion as follows:

Sub CopyHyperlink()
Dim Rng As Range
Set Rng = Selection.Hyperlinks(1).Range.Fields(1).Code
Rng.Copy
End Sub

This copied the following to the clipboard:

HYPERLINK "file:///C:\\Users\\Username\\Dropbox\\Doc.docx" \l "Bookmark Name"

Then using string and regex functions in Autohotkey, I was able to pare down the clipboard to just the following:

C:\Users\Username\Dropbox\Doc.docx#Bookmark Name

This is exactly what I was looking for, so thank you so much!

[macropod]

Originally Posted by poetofpiano

your version only copied the name of the bookmark instead of the full file path

That suggests the actual hyperlink lacked the enclosing double quotes. You also hadn't mentioned wanting to get the hyperlink sub-address (i.e. the bookmark). In that case, try:

Sub CopyHyperlink()
Dim Rng As Range
With Selection.Hyperlinks(1).Range.Fields(1)
  Set Rng = .Code
  With .Code
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = False
      .Forward = True
      .Wrap = wdFindStop
      .MatchWildcards = False
      .Text = "\l"
      .Replacement.Text = "#"
      .Execute Replace:=wdReplaceAll
      .Text = "HYPERLINK"
      .Replacement.Text = ""
      .Execute Replace:=wdReplaceAll
      .Text = "^w"
      .Execute Replace:=wdReplaceAll
      .Text = Chr(34)
      .Execute Replace:=wdReplaceAll
    End With
  End With
End With
Rng.Copy
While InStr(Rng.Text, "HYPERLINK") = 0
  Undo
Wend
End Sub

[gmayor]

Unless I am missing something here (it wouldn't be the first time) why not use the hyperlink address property? e.g.

Sub GetLinkAddress()
Dim dFname As DataObject
Dim hLink As Hyperlink
    Set hLink = Selection.Hyperlinks(1)
    Set dFname = New DataObject
    dFname.SetText hLink.Address
    dFname.PutInClipboard
    MsgBox hLink.Address & vbCr & "copied to clipboard"
lbl_Exit:
    Set hLink = Nothing
    Set dFname = Nothing
    Exit Sub
End Sub

[macropod]

I was trying to avoid setting a reference to the MS Forms 2.0 Object Library - which your code requires - plus getting both the hyperlink address and the hyperlink sub-address (if present) as a single, correctly-parsed, clipboard object - which I think your code also doesn't do.

[gmayor]

OK. I see your point, but the issues you raise are not insurmountable - how about

Sub GetLinkAddress2()
Dim hLink As Hyperlink
Dim oRng As Range
    Set oRng = ActiveDocument.Range
    oRng.Collapse 0
    Set hLink = Selection.Hyperlinks(1)
    oRng.Text = hLink.Address
    If Not hLink.SubAddress = "" Then oRng.Text = oRng.Text & "#" & hLink.SubAddress
    MsgBox oRng.Text & vbCr & "copied to clipboard"
    oRng.Cut
lbl_Exit:
    Set hLink = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

[macropod]

Yes, that's a god alternative (better in some ways, as my code didn't address the presence of other field switches), but one still needed use the MS Forms 2.0 Object Library:

Sub CopyHyperlink()
Dim StrTxt As String
With Selection.Hyperlinks(1)
  StrTxt = .Address
  If .SubAddress <> "" Then StrTxt = StrTxt & "#" & .SubAddress
  With .Range.Fields(1).Code
    .Text = StrTxt
    .Copy
  End With
  ActiveDocument.Undo
End With
End Sub

[poetofpiano]

Thank you both for your help. In the end I used Macropod's code:

Sub CopyHyperlink()
Dim StrTxt As String
With Selection.Hyperlinks(1)
  StrTxt = .Address
  If .SubAddress <> "" Then StrTxt = StrTxt & "#" & .SubAddress
  With .Range.Fields(1).Code
    .Text = StrTxt
    .Copy
  End With
End With
ActiveDocument.Undo
End Sub