.Hyperlinks.Add Error

[EvonS]

Thanks in advance for your help.

The code below works fine except in 2 cases (I speculate), 1. When there is too much text in the body, 2. When there are too many email addresses. I speculate that this is the problem because when the error does occur, things start working fine when I delete some of the body text or the number of email addresses. Is there some sort of character limit for this function I can account for?

The error I get is: "Run-time error '1004': Application-Defined or Object-Defined Error"

Using Windows 10 and Excel 2016

Sub insertVeryLongHyperlinkv3()
  Dim curCell As Range
  Dim longHyperlink As String
  Dim x As Long
  Dim situation As Variant
  Dim emails As Variant
  'Dim tdate As Integer
  'Dim sdate As Integer
  Dim EmailBody As String

  x = 2
    
  Do
    situation = Cells(x, 1)
    emails = Cells(x, "G")  'Cells(x, 7)
    EmailBody = "&body=Please use this email thread to communicate situation updates and next steps." & _
      "%0A%0A" & "Date: " & Cells(x, 2) & _
      "%0A%0A" & "Originating Agency: " & Cells(x, 3) & "%0A%0A" & "Lead Agency: " & Cells(x, 4) & _
      "%0A%0A" & "Assisting Agencies: " & Cells(x, 5) & "%0A%0A" & "Situation Information: " & Cells(x, 6)
    Set curCell = Range("H" & x) ' or use any cell-reference
    longHyperlink = "mailto:" & emails & [H1] & "?subject=" & situation & " Thread" & EmailBody ' Or a Cell reference like [C1]
  
    curCell.Hyperlinks.Add Anchor:=curCell, _
      Address:=longHyperlink, _
      SubAddress:="", _
      ScreenTip:=" - Click here to create email thread", _
      TextToDisplay:="Create " & situation & " Email Thread"
  
    x = x + 1
  Loop Until Cells(x, 7) = 0

 

[EvonS]

Any ideas anyone?

 

[EvonS]

Bump