VBA Create Email Links

EvonS

Board Regular
Joined
Jun 1, 2016
Messages
111
Office Version
  1. 365
Platform
  1. Windows
  2. Web
So the table below spans columns A-G

[TABLE="class: grid, width: 800"]
<tbody>[TR]
[TD]Situation[/TD]
[TD]Date[/TD]
[TD]Originating Agency[/TD]
[TD]Lead[/TD]
[TD]Assisting[/TD]
[TD]Summary[/TD]
[TD]Email List[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Jan 1[/TD]
[TD]TCHC[/TD]
[TD]ODSP[/TD]
[TD]TPS[/TD]
[TD]Summary goes here[/TD]
[TD]emai1@email.com[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Jan 1[/TD]
[TD]TESS[/TD]
[TD]EMS[/TD]
[TD]TCHC[/TD]
[TD]Summary goes here[/TD]
[TD]emails@emails.com[/TD]
[/TR]
</tbody>[/TABLE]

I have a button that creates email links in column H containing the info in each line of the table so that I can send an email to the people in the email list. I accomplish this, using this code

Code:
Sub insertVeryLongHyperlinkv2()


    Dim curCell As Range
    Dim longHyperlink As Variant
    Dim x As Integer
    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, 7)
            EmailBody = "&body=Please use this email thread to communicate situation updates and next steps." & "%0A%0A" & "Confidential identifying information should be sent to those requiring the information in a separate email or via other means" & "%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




End Sub

The code creates the first link just fine but gives me a "Run-time error '1004' Application or object-defined error" error before it creates the second link. Debug highlights this entire section:
Code:
curCell.Hyperlinks.Add Anchor:=curCell, _
                            Address:=longHyperlink, _
                            SubAddress:="", _
                            ScreenTip:=" - Click here to create email thread", _
                            TextToDisplay:="Create " & situation & " Email Thread"
Debug also has an arrow at the "TextToDisplay:" line.

Your help would really be appreciated.


Thanks,

Evon
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Code:
ActiveSheet.Hyperlinks.Add Anchor:=curCell, Address:=longHyperlink, _
   SubAddress:="", ScreenTip:=" - Click here to create email thread", _
    TextToDisplay:="Create " & situation & " Email Thread"
 
Last edited:
Upvote 0
Thanks for the reply. That code yields the exact same error.
 
Upvote 0
It ran ok for me using your sample data. Maybe you had some locked cells?

Code:
Sub insertVeryLongHyperlinkv2()
  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" & "Confidential identifying information should be sent to those requiring the " & _
      "information in a separate email or via other means" & "%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
End Sub
 
Last edited:
Upvote 0
Thanks for taking the time to help me. There are no locked cells in my sheet. I've even tried changing where the links are created but the same thing happens. Do you have any other troubleshooting tips?
 
Upvote 0
So I used your code and I get the same error in the same place. I guess there's something up with my sheet but I have no idea what. Any suggestions?
 
Upvote 0
So I figured out the issue. When I use the code l my actual worksheet, an error occurs whenever it tries to create an email that has too many characters. Thanks for the help.
 
Upvote 0
Solution

Forum statistics

Threads
1,223,248
Messages
6,171,027
Members
452,374
Latest member
keccles

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top