VBA to Create Variable with Multiple URLs

[Barklie]

Hello,

I have written the following code to create a message with two hyperlinks embedded and then copy that message to the clipboard. I am getting a Run-time error saying "Automation Error" and "Unspecified error" when executing the .hyperlinks line of code. Any help would be tremendously appreciated.

Sub ES_Message2()


'Dimension variables
Dim ArticleOneURL As Range
Dim ArticleTwoURL As Range


'Assign hyperlinks
With ActiveSheet
    .Hyperlinks.Add Anchor:=ArticleOneURL, Address:="https://docs.microsoft.com/en-us/office/vba/api/excel.hyperlinks.add", TextToDisplay:="see here"
End With
With ActiveSheet
    .Hyperlinks.Add Anchor:=ArticleTwoURL, Address:="https://docs.microsoft.com/en-us/office/vba/api/excel.hyperlinks.add", TextToDisplay:="see here"
End With


'Create Message
EmailMessage = "Hi Customer, please follow the follow our article on topic 1 (" & ArticleOneURL & ") and topic 2 (" & ArticleTwoURL & ")."


'Copy message to clipboard
With New MSForms.DataObject
    .SetText EmailMessage
    .PutInClipboard
End With


End Sub

 

[Barklie]

I never ended up getting this to work. The solution I landed on is to open a Word template up (which already has the URL links in it), replace the variables, and copy the message with send keys. Templates aren't my favorite way, but it does the trick.

Sub ES_Message2()

'Dimension variables
Dim WordApp As word.Application
Dim myDoc As word.Document
Dim WordTable As word.Table


'Assign variables
FirstName = Sheets("Design").Range("B1")
DesignerName = Range("B4")
ThirtyYearSavings = Application.WorksheetFunction.RoundDown(Range("B29"), -2)
NetPrice = Range("B13")


'Check for missing variables
If FirstName = "" Or DesignerName = "" Or ThirtyYearSavings = "" Or NetPrice = "" Then MsgBox "Variables missing. Please check that all the variable fields are filled"


'Create an Instance of MS Word
  On Error Resume Next
    
    'Is MS Word already opened?
      Set WordApp = GetObject(class:="Word.Application")
    
    'Clear the error between errors
      Err.Clear
    'If MS Word is not already open then open MS Word
      If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")
    
    'Handle if the Word Application is not found
      If Err.Number = 429 Then
        MsgBox "Microsoft Word could not be found, aborting."
        'GoTo EndRoutine
      End If
  On Error GoTo 0
  
'Make MS Word Visible and Active
  WordApp.Visible = True
  WordApp.Activate
    
'Change: [Set myDoc = WordApp.Documents.Add] to:
  Set myDoc = WordApp.Documents.Open("C:\Users\Barklie\OneDrive\Solar Company\Sales\Templates\ES_Message2.docx")
  
'Insert values
myDoc.Bookmarks("FirstName").Range.Text = FirstName
myDoc.Bookmarks("DesignerName").Range.Text = DesignerName
myDoc.Bookmarks("ThirtyYearSavings").Range.Text = ThirtyYearSavings
myDoc.Bookmarks("NetPrice").Range.Text = NetPrice


'Update fields
myDoc.Fields.Update


'Copy to clipboard
SendKeys "^a"
SendKeys "^c"
Application.Wait (Now + TimeSerial(0, 0, 2))
  
'Close document
myDoc.Close SaveChanges:=wdDoNotSaveChanges

End Sub