Hyperlink function Error

R

Ramadan

Board Regular
Joined
Jan 20, 2024
Messages
193
Office Version
  1. 2021
Platform
  1. Windows
I'm trying attach excel sheet in email and to add dynamic cells in the email subject and body that can be changed everytime based on the selected row but i can't find such a way yet even with vba
you can find my question here

How to Send excel sheet with email including dynamic cells in subject and body text

I have an excel sheet with a table containing all the members subscriptions details. And every time a member renews his subscription, I need to send email with his membership details to all the team I had for info. and to print him a new ID. I had a code in other sheet to send the sheet but I...
www.mrexcel.com www.mrexcel.com

So, alternatively I tried to create a hyperlink function in front of each row of the table to send email based on the row data and to attach the file manually but I'm facing some troubles with the hyberlink function

=HYPERLINK("mailto:"&$R$9&"?subject="&$R$8&" "&"("&B8&")"&"&cc="&$R$10&"&body="&$R$11&" "&"("&B8&")"&" وذلك خلال الفترة من "&" "&"("&J8&")"&"وحتى"&" "&"("&J8&")"&M8&"%0Aبرجاء طباعة العضوية حسب الكسشف المرسل"&"&R12,"Email")

1- in the email body the dates in the table are shown as text number even after making sure that cells "J8 & K8" in the table are formatted as short date
2- when I try to add a long text to the function string more than the words you can see I get error
2- I tried to refer to a cell instead of adding text to the function itself which is better for me but I'm stuck with one last part (&"&R12 marked in red)
3- I don't have any idea how to add my email signature to the email body

if you have any suggestion will be much appreciated

Untitled 1.png
 
Sort by date Sort by votes
Shall we continue with the link referencing your earlier post here.
Hyberlink function Error_Ramadan.xlsx
BCDEFGHIJKLMNOP
1IDRef#RemarksStatusDatesPhoneIDUiser NameTelOwnerNHUnit$
2ToFrom
3Column13Column12Column11Column10Column9Column8Column7Column13Column6Column5Column4Column3Column2Column1
4Email012newلاغي25.01.2324.12.24User1006556625OwenerNH022341
5Email027newسازی25.04.2125.03.221.1E+09User1149719995OwenerNH01133 NEW 012
6Email0310newلاغي24.07.0124.06.02User1002718909OwenerNH01CTH 773
7Email#NAME?11newلاغي25.03.0325.02.04User123955989OwenerNH02B7024
8Email#NAME?17newلاغي25.03.0125.01.021.1E+09User1220999959OwenerNH0109 NEW 225
9Email#NAME?18newلاغي24.10.0724.09.08User1223116238OwenerNH02A6256
10Email#NAME?20newلاغي24.11.0124.10.02User1222114615OwenerNH02A2147
11Email#NAME?28newسازی25.04.0225.03.03User1114000242OwenerNH02F4148
12Email#NAME?36newسازی25.03.2325.02.241.2E+09UserOwenerNH03132 NEW 139
13Email#NAME?50newلاغي24.09.2624.08.27User1221719038OwenerNH01CR 62B SL10
Sheet1
 
Upvote 0
Sam_D_Ben said:
Shall we continue with the link referencing your earlier post here.
Hyberlink function Error_Ramadan.xlsx
BCDEFGHIJKLMNOP
1IDRef#RemarksStatusDatesPhoneIDUiser NameTelOwnerNHUnit$
2ToFrom
3Column13Column12Column11Column10Column9Column8Column7Column13Column6Column5Column4Column3Column2Column1
4Email012newلاغي25.01.2324.12.24User1006556625OwenerNH022341
5Email027newسازی25.04.2125.03.221.1E+09User1149719995OwenerNH01133 NEW 012
6Email0310newلاغي24.07.0124.06.02User1002718909OwenerNH01CTH 773
7Email#NAME?11newلاغي25.03.0325.02.04User123955989OwenerNH02B7024
8Email#NAME?17newلاغي25.03.0125.01.021.1E+09User1220999959OwenerNH0109 NEW 225
9Email#NAME?18newلاغي24.10.0724.09.08User1223116238OwenerNH02A6256
10Email#NAME?20newلاغي24.11.0124.10.02User1222114615OwenerNH02A2147
11Email#NAME?28newسازی25.04.0225.03.03User1114000242OwenerNH02F4148
12Email#NAME?36newسازی25.03.2325.02.241.2E+09UserOwenerNH03132 NEW 139
13Email#NAME?50newلاغي24.09.2624.08.27User1221719038OwenerNH01CR 62B SL10
Sheet1
Click to expand...
@Sam_D_Ben yes sure if this is not against the platform rules
 
Upvote 0
Please try,
VBA Code: 
Public Sub Send_Email()

    On Error GoTo CleanFail

    Dim ws As Worksheet
    Set ws = ActiveSheet

    If ActiveCell.Column <> 16 Then
        MsgBox "Please click a cell in column P to send the email.", vbExclamation
        Exit Sub
    End If

    Dim activeRow As Long
    activeRow = ActiveCell.Row

    Dim membershipNo As String, startDate As String, endDate As String
    membershipNo = Trim(ws.Cells(activeRow, "B").Value)
    startDate = Trim(ws.Cells(activeRow, "J").Value)
    endDate = Trim(ws.Cells(activeRow, "K").Value)

    Dim ToEmail As String, CCEmail As String
    ToEmail = Trim(ws.Range("R9").Value)
    CCEmail = Trim(ws.Range("R10").Value)

    If membershipNo = "" Or startDate = "" Or endDate = "" Then
        MsgBox "Membership No, Start Date, or End Date is missing in row " & _
               activeRow, vbCritical
        Exit Sub
    End If

    If ToEmail = "" Then
        MsgBox "The 'To' email address in cell R9 is missing.", vbCritical
        Exit Sub
    End If

    Dim outApp As Object
    On Error Resume Next
    Set outApp = CreateObject("Outlook.Application")
    On Error GoTo CleanFail

    If outApp Is Nothing Then
        MsgBox "Outlook is not available on this system.", vbCritical
        Exit Sub
    End If

    Dim outMail As Object
    Set outMail = outApp.CreateItem(0)

    Dim newHTML As String
    newHTML = "<p>Dear Team,</p>" & vbCrLf & _
              "<p>Kindly find attached the renewed membership No. <b>" & _
              membershipNo & "</b> for the period from <b>" & startDate & _
              "</b> to <b>" & endDate & "</b>.</p>" & vbCrLf & _
              "<p>Please print a new ID according to the details.</p>"

    Dim HTML As String
    With outMail
        .GetInspector
        HTML = .HTMLBody
    End With

    Dim p1 As Long, p2 As Long
    p1 = InStr(1, HTML, "<p ", vbTextCompare)
    p2 = InStr(p1 + 1, HTML, "<p ", vbTextCompare)
    p2 = InStr(p2, HTML, "</p>")
    HTML = Left(HTML, p1 - 1) & _
           Mid(HTML, p2 + Len("</p>"))

    p1 = InStr(1, HTML, "<body", vbTextCompare)
    p1 = InStr(p1, HTML, ">")
    HTML = Left(HTML, p1) & _
           newHTML & _
           Mid(HTML, p1 + 1)

    Dim filePath As String
    filePath = "D:\Desktop\Guards\gurads list.xlsm" 'Change if different

    If Dir(filePath) = "" Then
        MsgBox "Attachment not found: " & filePath, vbCritical
        Exit Sub
    End If

    With outMail
        .To = ToEmail
        .CC = CCEmail
        .Subject = "Renewed membership No. " & membershipNo
        .HTMLBody = HTML
        .Attachments.Add filePath
        .Display ' Change to .Send to send automatically
    End With

    Set outMail = Nothing
    Set outApp = Nothing
    Exit Sub

CleanFail:
    MsgBox "Error occurred: " & Err.Description, vbCritical

End Sub
 
Upvote 0
Solution
Sam_D_Ben said:
Please try,
VBA Code: 
Public Sub Send_Email()

    On Error GoTo CleanFail

    Dim ws As Worksheet
    Set ws = ActiveSheet

    If ActiveCell.Column <> 16 Then
        MsgBox "Please click a cell in column P to send the email.", vbExclamation
        Exit Sub
    End If

    Dim activeRow As Long
    activeRow = ActiveCell.Row

    Dim membershipNo As String, startDate As String, endDate As String
    membershipNo = Trim(ws.Cells(activeRow, "B").Value)
    startDate = Trim(ws.Cells(activeRow, "J").Value)
    endDate = Trim(ws.Cells(activeRow, "K").Value)

    Dim ToEmail As String, CCEmail As String
    ToEmail = Trim(ws.Range("R9").Value)
    CCEmail = Trim(ws.Range("R10").Value)

    If membershipNo = "" Or startDate = "" Or endDate = "" Then
        MsgBox "Membership No, Start Date, or End Date is missing in row " & _
               activeRow, vbCritical
        Exit Sub
    End If

    If ToEmail = "" Then
        MsgBox "The 'To' email address in cell R9 is missing.", vbCritical
        Exit Sub
    End If

    Dim outApp As Object
    On Error Resume Next
    Set outApp = CreateObject("Outlook.Application")
    On Error GoTo CleanFail

    If outApp Is Nothing Then
        MsgBox "Outlook is not available on this system.", vbCritical
        Exit Sub
    End If

    Dim outMail As Object
    Set outMail = outApp.CreateItem(0)

    Dim newHTML As String
    newHTML = "<p>Dear Team,</p>" & vbCrLf & _
              "<p>Kindly find attached the renewed membership No. <b>" & _
              membershipNo & "</b> for the period from <b>" & startDate & _
              "</b> to <b>" & endDate & "</b>.</p>" & vbCrLf & _
              "<p>Please print a new ID according to the details.</p>"

    Dim HTML As String
    With outMail
        .GetInspector
        HTML = .HTMLBody
    End With

    Dim p1 As Long, p2 As Long
    p1 = InStr(1, HTML, "<p ", vbTextCompare)
    p2 = InStr(p1 + 1, HTML, "<p ", vbTextCompare)
    p2 = InStr(p2, HTML, "</p>")
    HTML = Left(HTML, p1 - 1) & _
           Mid(HTML, p2 + Len("</p>"))

    p1 = InStr(1, HTML, "<body", vbTextCompare)
    p1 = InStr(p1, HTML, ">")
    HTML = Left(HTML, p1) & _
           newHTML & _
           Mid(HTML, p1 + 1)

    Dim filePath As String
    filePath = "D:\Desktop\Guards\gurads list.xlsm" 'Change if different

    If Dir(filePath) = "" Then
        MsgBox "Attachment not found: " & filePath, vbCritical
        Exit Sub
    End If

    With outMail
        .To = ToEmail
        .CC = CCEmail
        .Subject = "Renewed membership No. " & membershipNo
        .HTMLBody = HTML
        .Attachments.Add filePath
        .Display ' Change to .Send to send automatically
    End With

    Set outMail = Nothing
    Set outApp = Nothing
    Exit Sub

CleanFail:
    MsgBox "Error occurred: " & Err.Description, vbCritical

End Sub
Click to expand...
@Sam_D_Ben First I want to thank you so much for spending the time to create this long code which is perfect and working smoothly. Just I need to ask you If you can change only the subject & body text to refer to a cells like "R11 & R12" for example because I need to change the text to Arabic and I can't do this inside the code itself. but please to keep the cells "B" , "J" & "K" the same in there place and to add cell "M" value directly after end date "K" . I do appreciate if you can do that please as I need it to be like this image (I need 5 lines in body text)
44.png

​
 
Upvote 0
Sam_D_Ben said:
Please try,
VBA Code: 
Public Sub Send_Email()

    On Error GoTo CleanFail

    Dim ws As Worksheet
    Set ws = ActiveSheet

    If ActiveCell.Column <> 16 Then
        MsgBox "Please click a cell in column P to send the email.", vbExclamation
        Exit Sub
    End If

    Dim activeRow As Long
    activeRow = ActiveCell.Row

    Dim membershipNo As String, startDate As String, endDate As String
    membershipNo = Trim(ws.Cells(activeRow, "B").Value)
    startDate = Trim(ws.Cells(activeRow, "J").Value)
    endDate = Trim(ws.Cells(activeRow, "K").Value)

    Dim ToEmail As String, CCEmail As String
    ToEmail = Trim(ws.Range("R9").Value)
    CCEmail = Trim(ws.Range("R10").Value)

    If membershipNo = "" Or startDate = "" Or endDate = "" Then
        MsgBox "Membership No, Start Date, or End Date is missing in row " & _
               activeRow, vbCritical
        Exit Sub
    End If

    If ToEmail = "" Then
        MsgBox "The 'To' email address in cell R9 is missing.", vbCritical
        Exit Sub
    End If

    Dim outApp As Object
    On Error Resume Next
    Set outApp = CreateObject("Outlook.Application")
    On Error GoTo CleanFail

    If outApp Is Nothing Then
        MsgBox "Outlook is not available on this system.", vbCritical
        Exit Sub
    End If

    Dim outMail As Object
    Set outMail = outApp.CreateItem(0)

    Dim newHTML As String
    newHTML = "<p>Dear Team,</p>" & vbCrLf & _
              "<p>Kindly find attached the renewed membership No. <b>" & _
              membershipNo & "</b> for the period from <b>" & startDate & _
              "</b> to <b>" & endDate & "</b>.</p>" & vbCrLf & _
              "<p>Please print a new ID according to the details.</p>"

    Dim HTML As String
    With outMail
        .GetInspector
        HTML = .HTMLBody
    End With

    Dim p1 As Long, p2 As Long
    p1 = InStr(1, HTML, "<p ", vbTextCompare)
    p2 = InStr(p1 + 1, HTML, "<p ", vbTextCompare)
    p2 = InStr(p2, HTML, "</p>")
    HTML = Left(HTML, p1 - 1) & _
           Mid(HTML, p2 + Len("</p>"))

    p1 = InStr(1, HTML, "<body", vbTextCompare)
    p1 = InStr(p1, HTML, ">")
    HTML = Left(HTML, p1) & _
           newHTML & _
           Mid(HTML, p1 + 1)

    Dim filePath As String
    filePath = "D:\Desktop\Guards\gurads list.xlsm" 'Change if different

    If Dir(filePath) = "" Then
        MsgBox "Attachment not found: " & filePath, vbCritical
        Exit Sub
    End If

    With outMail
        .To = ToEmail
        .CC = CCEmail
        .Subject = "Renewed membership No. " & membershipNo
        .HTMLBody = HTML
        .Attachments.Add filePath
        .Display ' Change to .Send to send automatically
    End With

    Set outMail = Nothing
    Set outApp = Nothing
    Exit Sub

CleanFail:
    MsgBox "Error occurred: " & Err.Description, vbCritical

End Sub
Click to expand...
@Sam_D_Ben for not bothering you too much bro, I tried and succeded to do some edits to match my needs as you can see in the code below and now just please I need your help to make the body refer to some cells in Col "R" and to make the body fromat right to left .. Thanks a Million

VBA Code: 
Public Sub Send_Email()

    On Error GoTo CleanFail

    Dim ws As Worksheet
    Set ws = ActiveSheet

    If ActiveCell.Column <> 16 Then
        MsgBox "Please click a cell in column P to send the email.", vbExclamation
        Exit Sub
    End If

    Dim activeRow As Long
    activeRow = ActiveCell.Row

    Dim membershipNo As String, startDate As String, endDate As String, period As String
    
    membershipNo = Trim(ws.Cells(activeRow, "B").Value)
    startDate = Trim(ws.Cells(activeRow, "J").Value)
    endDate = Trim(ws.Cells(activeRow, "K").Value)
    period = Trim(ws.Cells(activeRow, "M").Value)
    
    Dim ToEmail As String, CCEmail As String
    ToEmail = Trim(ws.Range("R9").Value)
    CCEmail = Trim(ws.Range("R10").Value)
    Subject = Trim(ws.Range("R11").Value)
    

    If membershipNo = "" Or startDate = "" Or endDate = "" Then
        MsgBox "Membership No, Start Date, or End Date is missing in row " & _
               activeRow, vbCritical
        Exit Sub
    End If

    If ToEmail = "" Then
        MsgBox "The 'To' email address in cell R9 is missing.", vbCritical
        Exit Sub
    End If

    Dim outApp As Object
    On Error Resume Next
    Set outApp = CreateObject("Outlook.Application")
    On Error GoTo CleanFail

    If outApp Is Nothing Then
        MsgBox "Outlook is not available on this system.", vbCritical
        Exit Sub
    End If

    Dim outMail As Object
    Set outMail = outApp.CreateItem(0)

    Dim newHTML As String
    newHTML = "<p> Dear Team </p>" & vbCrLf & _
              "<p>Kindly find attached the renewed membership No.( <b>" & _
              membershipNo & ")" & "</b> for the period from  <b>" & "(" & startDate & _
              "</b> to <b>" & endDate & ")" & "  " & period & "</b>.</p>" & vbCrLf & _
              "<p>Please print a new ID according to the details.</p>"

    Dim HTML As String
    With outMail
        .GetInspector
        HTML = .HTMLBody
    End With

    Dim p1 As Long, p2 As Long
    p1 = InStr(1, HTML, "<p ", vbTextCompare)
    p2 = InStr(p1 + 1, HTML, "<p ", vbTextCompare)
    p2 = InStr(p2, HTML, "</p>")
    HTML = Left(HTML, p1 - 1) & _
           Mid(HTML, p2 + Len("</p>"))

    p1 = InStr(1, HTML, "<body", vbTextCompare)
    p1 = InStr(p1, HTML, ">")
    HTML = Left(HTML, p1) & _
           newHTML & _
           Mid(HTML, p1 + 1)

    Dim filePath As String
    filePath = "D:\Desktop\Guards\gurads list.xlsm" 'Change if different

    If Dir(filePath) = "" Then
        MsgBox "Attachment not found: " & filePath, vbCritical
        Exit Sub
    End If

    With outMail
        .To = ToEmail
        .CC = CCEmail
        .Subject = Subject & "  " & "(" & membershipNo & ")"
        .HTMLBody = HTML
        .Attachments.Add filePath
        .Display ' Change to .Send to send automatically
    End With

    Set outMail = Nothing
    Set outApp = Nothing
    Exit Sub

CleanFail:
    MsgBox "Error occurred: " & Err.Description, vbCritical

End Sub
 
Upvote 0
Replace this,
VBA Code: 
          Dim newHTML As String
          newHTML = "<p> Dear Team </p>" & vbCrLf & _
              "<p>Kindly find attached the renewed membership No.( <b>" & _
              membershipNo & ")" & "</b> for the period from  <b>" & "(" & startDate & _
              "</b> to <b>" & endDate & ")" & "  " & period & "</b>.</p>" & vbCrLf & _
              "<p>Please print a new ID according to the details.</p>
with this, since i dont know what is in R cells, Please change it accordingly.
VBA Code: 
    Dim body1 As String, body2 As String, body3 As String
    body1 = ws.Range("R12").Value
    body2 = ws.Range("R13").Value
    body3 = ws.Range("R14").Value
    
    Dim newHTML As String
    newHTML = "<div dir='rtl' style='font-family:Calibri; font-size:11pt;'>" & _
              "<p>" & body1 & "</p>" & _
              "<p>" & body2 & " <b>(" & membershipNo & ")</b> for the period from <b>(" & _
              StartDate & ")</b> to <b>(" & EndDate & ")</b> " & Period & ".</p>" & _
              "<p>" & body3 & "</p>" & _
              "</div>"
 
Upvote 0
Sam_D_Ben said:
Replace this,
VBA Code: 
          Dim newHTML As String
          newHTML = "<p> Dear Team </p>" & vbCrLf & _
              "<p>Kindly find attached the renewed membership No.( <b>" & _
              membershipNo & ")" & "</b> for the period from  <b>" & "(" & startDate & _
              "</b> to <b>" & endDate & ")" & "  " & period & "</b>.</p>" & vbCrLf & _
              "<p>Please print a new ID according to the details.</p>
with this, since i dont know what is in R cells, Please change it accordingly.
VBA Code: 
    Dim body1 As String, body2 As String, body3 As String
    body1 = ws.Range("R12").Value
    body2 = ws.Range("R13").Value
    body3 = ws.Range("R14").Value
  
    Dim newHTML As String
    newHTML = "<div dir='rtl' style='font-family:Calibri; font-size:11pt;'>" & _
              "<p>" & body1 & "</p>" & _
              "<p>" & body2 & " <b>(" & membershipNo & ")</b> for the period from <b>(" & _
              StartDate & ")</b> to <b>(" & EndDate & ")</b> " & Period & ".</p>" & _
              "<p>" & body3 & "</p>" & _
              "</div>"
Click to expand...
@Sam_D_Ben that's more than perfect :) I really do appreciate your help the code is very smooth and fast. just please please one last issue I don't know how to fix (the StartDate and EndDate format in the body are shown as ( dd.mm.yy) while in need them to be (yy.mm.dd) the same as in the sheet- thank you bro so much you really saved for me dayed and weeks from searching
 
Upvote 0
Replace this,
VBA Code: 
startDate = Trim(ws.Cells(activeRow, "J").Value)
endDate = Trim(ws.Cells(activeRow, "K").Value)
with this,
VBA Code: 
startDate = Format(ws.Cells(activeRow, "J").Value, "yy.mm.dd")
endDate = Format(ws.Cells(activeRow, "K").Value, "yy.mm.dd")
 
Upvote 0
Sam_D_Ben said:
Replace this,
VBA Code: 
startDate = Trim(ws.Cells(activeRow, "J").Value)
endDate = Trim(ws.Cells(activeRow, "K").Value)
with this,
VBA Code: 
startDate = Format(ws.Cells(activeRow, "J").Value, "yy.mm.dd")
endDate = Format(ws.Cells(activeRow, "K").Value, "yy.mm.dd")
Click to expand...
@Sam_D_Ben Wow :) you are more than professional bro. it's more than perfect and very fast thank you so much
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
How to Send excel sheet with email including dynamic cells in subject and body text
Replies
8
Views
194
John_w
J
K
  • Question Question
Hyperlink to send email. Need the body of the email to exceed the 255 character max
Replies
1
Views
81
Micron
M
J
  • Question Question
Send bulk email attachment error
Replies
3
Views
336
JOHATUP
J
C
  • Solved
VBA - Copying Range to an E-Mail Body
Replies
8
Views
452
Logit
Logit
L
  • Question Question
Compile error: Variable not defined
Replies
3
Views
387
lharr28
L

Share this page

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