VBA Email Hyperlink to Workaround 255 Character Limit, With Conditions

AJLS

New Member
Joined
Sep 14, 2023
Messages
21
Office Version
  1. 365
Platform
  1. Windows
Hi All,

I have seen threads with a solution to beat the 255 character limit, I am unable to amend it to work with the conditions i am looking for. The formula I have that works when below the character limit is:

=IF(F3=Sheet2!$A$4,HYPERLINK("mailto:"&Sheet2!$H$1&"?subject="&A3&" "&B3&" &body=Hello, %0A%0AThe Parts for "&C3&" have arrived and are stored in location "&H3&".%0A%0ABest Regards%0A%0APRT Goods In","Notify Receipt"),IF(F3=Sheet2!$A$3,HYPERLINK("mailto:"&Sheet2!$H$1& "?subject="&A3&" "&B3&" &body=Hello, %0A%0AThe Parts for "&C3&" have now shipped.%0A%0ABest Regards%0A%0APRT Aberdeen","Notify Shipment"),"N/A"))

I can get away with this depending on the content of the cells that make up the email. I have added a snip of the worksheet, any help would be greatly appreciated.

Thank you
 

Attachments

  • Worksheet Snip.png
    Worksheet Snip.png
    24.5 KB · Views: 21

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
I guess you'll have to use vba instead? Or if you've found a solution but can't make it work why not post a link to it and state what conditions you have that are different and causing the solution to not work?
 
Upvote 0
Hi Micron,

Apologies for the delay. Yes, VBA will be the solution, I have put the below together from what I have found online. It does exactly what I am looking for based on the data from one row for the "Notify Receipt" Option in the above formula.

VBA Code:
[
Option Explicit

Sub create_and_email_pdf()



Dim EmailSubject As String, EmailBody As String, EmailSignature As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim DisplayEmail As Boolean
Dim OutlookApp As Object, OutlookMail As Object


' *****************************************************
' *****     You Can Change These Variables    *********

    EmailSubject = Range("A3") & " " & Range("B3")  'Change this to change the subject of the email. The current month is added to end of subj line
    EmailBody = "Hello," & vbNewLine & vbNewLine & _
    "The Parts for" & " " & Range("C3") & " " & "have arrived and are stored in location" & " " & Range("H3") & "." & vbNewLine & vbNewLine & _
    "Best Regards" & vbNewLine & vbNewLine & _
    "PRT Goods In"
    DisplayEmail = True 'Change this if you don't want to display the email before sending.  Note, you must have a TO email address specified for this to work
    Email_To = Worksheets("Sheet2").Range("H1")   'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1
    Email_CC = ""
    Email_BCC = ""
        
' ******************************************************


    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
     
    'Display email and specify To, Subject, etc
    With OutlookMail
     
        .Display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject
        .Body = EmailBody
        If DisplayEmail = False Then
         
            .Send
         
        End If
     
    End With
 
 
End Sub

To keep the functionality of the mailto I was using, I am hoping to incorporate the If function covering the "Notify Receipt" and "Notify Shipment" hyperlink/button options and the "N/A" if the conditions are not met in column "I". Then i can look to change to dynamic ranges to avoid repeating the macro.

Thank you
 
Upvote 0
If you're open to any suggestions:
Spaces are just like any other character in that they don't have to be seperate concatenations.
"The Parts for " & Range("C3") & " have arrived and are stored in location " & Range("H3") & "."
is simpler than
"The Parts for" & " " & Range("C3") & " " & "have arrived and are stored in location" & " " & Range("H3") & "."

IF the process supports it, you can pass the display/send option to the sub. Otherwise you have to alter code for each instance and that is risky and not good practice.
 
Upvote 0
If you're open to any suggestions:
Spaces are just like any other character in that they don't have to be seperate concatenations.
"The Parts for " & Range("C3") & " have arrived and are stored in location " & Range("H3") & "."
is simpler than
"The Parts for" & " " & Range("C3") & " " & "have arrived and are stored in location" & " " & Range("H3") & "."

IF the process supports it, you can pass the display/send option to the sub. Otherwise you have to alter code for each instance and that is risky and not good practice.
I think I am getting somewhere, I have added in a double click function that I can use instead of a command button, I am struggling to change the fixed cell references to a dynamic range. Well noted on the spacing, much simpler, thanks.

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim EmailSubject As String, EmailBody As String, EmailSignature As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim DisplayEmail As Boolean
Dim OutlookApp As Object, OutlookMail As Object

    If Not Intersect(Target, Range("H2:H10000")) Is Nothing Then [P2: P10000]

   lineNumber = Target.Row

Dim xO
 
    EmailSubject = Range("A2") & " " & Range("B2")
    EmailBody = "Hello," & vbNewLine & vbNewLine & _
    "The Parts for " & Range("C2") & " have arrived and are stored in location " & Range("F2") & "." & vbNewLine & vbNewLine & _
    "Best Regards" & vbNewLine & vbNewLine & _
    "PRT Goods In"
    DisplayEmail = True
    Email_To = Worksheets("Sheet2").Range("H1")
    Email_CC = ""
    Email_BCC = ""
          
' ******************************************************


    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
       
    'Display email and specify To, Subject, etc
    With OutlookMail
       
        .Display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject
        .Body = EmailBody
        If DisplayEmail = False Then
           
            .Send
           
        End If
       
    End With
   
 
End Sub
 
Last edited:
Upvote 0
I am struggling to change the fixed cell references to a dynamic range
Not sure what that means but if it refers to Range("H2:H10000")) consider a type 8 input box to capture the desired range. You can drag a range to input it, or rather than drag over 1000 rows, drag and edit the input text before committing it. If it refers to other of the several ranges your code uses, then perhaps incrementing a counter while looping over rows and using the count to .Offset the range. I have a notion that 1000 is just a value that you figure will cover the need for some time and that you really don't have 1000 emails to send each time.

One thing I often don't see in this sort of code is a flag to id the rows where an email was sent. Imagine starting this sub several times in order to get all Sent that didn't get sent the first few times because of code failure or missing data. The successfully sent receive the same email several times as you work it out.
 
Upvote 0
Not sure what that means but if it refers to Range("H2:H10000")) consider a type 8 input box to capture the desired range. You can drag a range to input it, or rather than drag over 1000 rows, drag and edit the input text before committing it. If it refers to other of the several ranges your code uses, then perhaps incrementing a counter while looping over rows and using the count to .Offset the range. I have a notion that 1000 is just a value that you figure will cover the need for some time and that you really don't have 1000 emails to send each time.

One thing I often don't see in this sort of code is a flag to id the rows where an email was sent. Imagine starting this sub several times in order to get all Sent that didn't get sent the first few times because of code failure or missing data. The successfully sent receive the same email several times as you work it out.
Sorry, I should have clarified further. The H2:H10000 is adding the double click function to each cell in column H, you are correct in the 10000 being a nominal value, the sheet will have around 30 lines. What I am looking to achieve is to have the email composed from the data in cells A, B, C, and F in the same row as the cell that is double clicked.

I am unsure about the flag to ID the rows, that is likely residual from the code I have used to pit this together. I am not seasoned in VBA I find things online and (try) to amend so they work.

Thanks
 
Upvote 0
Hi, you could give this a try:

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim EmailSubject As String, EmailBody As String, EmailSignature As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim DisplayEmail As Boolean
Dim OutlookApp As Object, OutlookMail As Object
Dim lineNumber As Long

If Not Intersect(Target, Range("H2:H10000")) Is Nothing Then
    
    Cancel = True 'Stop the double click from edititing the cell
    
    lineNumber = Target.Row

    EmailSubject = Range("A" & lineNumber) & " " & Range("B" & lineNumber)
    EmailBody = "Hello," & vbNewLine & vbNewLine & _
    "The Parts for " & Range("C" & lineNumber) & " have arrived and are stored in location " & Range("F" & lineNumber) & "." & vbNewLine & vbNewLine & _
    "Best Regards" & vbNewLine & vbNewLine & _
    "PRT Goods In"
    DisplayEmail = True
    Email_To = Worksheets("Sheet2").Range("H1")
    Email_CC = ""
    Email_BCC = ""
          
' ******************************************************


    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
       
    'Display email and specify To, Subject, etc
    With OutlookMail
       
        .Display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject
        .Body = EmailBody
        
        If DisplayEmail = False Then
            .Send
        End If
       
    End With
   
End If
 
End Sub
 
Upvote 0
Solution
Hi, you could give this a try:

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim EmailSubject As String, EmailBody As String, EmailSignature As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim DisplayEmail As Boolean
Dim OutlookApp As Object, OutlookMail As Object
Dim lineNumber As Long

If Not Intersect(Target, Range("H2:H10000")) Is Nothing Then
   
    Cancel = True 'Stop the double click from edititing the cell
   
    lineNumber = Target.Row

    EmailSubject = Range("A" & lineNumber) & " " & Range("B" & lineNumber)
    EmailBody = "Hello," & vbNewLine & vbNewLine & _
    "The Parts for " & Range("C" & lineNumber) & " have arrived and are stored in location " & Range("F" & lineNumber) & "." & vbNewLine & vbNewLine & _
    "Best Regards" & vbNewLine & vbNewLine & _
    "PRT Goods In"
    DisplayEmail = True
    Email_To = Worksheets("Sheet2").Range("H1")
    Email_CC = ""
    Email_BCC = ""
         
' ******************************************************


    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
      
    'Display email and specify To, Subject, etc
    With OutlookMail
      
        .Display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject
        .Body = EmailBody
       
        If DisplayEmail = False Then
            .Send
        End If
      
    End With
  
End If
 
End Sub
HI FormR,

This works perfectly, thank you for the help.
 
Upvote 0
Hi, you could give this a try:

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim EmailSubject As String, EmailBody As String, EmailSignature As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim DisplayEmail As Boolean
Dim OutlookApp As Object, OutlookMail As Object
Dim lineNumber As Long

If Not Intersect(Target, Range("H2:H10000")) Is Nothing Then
 
    Cancel = True 'Stop the double click from edititing the cell
 
    lineNumber = Target.Row

    EmailSubject = Range("A" & lineNumber) & " " & Range("B" & lineNumber)
    EmailBody = "Hello," & vbNewLine & vbNewLine & _
    "The Parts for " & Range("C" & lineNumber) & " have arrived and are stored in location " & Range("F" & lineNumber) & "." & vbNewLine & vbNewLine & _
    "Best Regards" & vbNewLine & vbNewLine & _
    "PRT Goods In"
    DisplayEmail = True
    Email_To = Worksheets("Sheet2").Range("H1")
    Email_CC = ""
    Email_BCC = ""
       
' ******************************************************


    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    
    'Display email and specify To, Subject, etc
    With OutlookMail
    
        .Display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject
        .Body = EmailBody
     
        If DisplayEmail = False Then
            .Send
        End If
    
    End With
 
End If
 
End Sub


[/QUOTE]
 
Upvote 0

Forum statistics

Threads
1,215,069
Messages
6,122,952
Members
449,095
Latest member
nmaske

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