why this code opens two emails and reference isn't valid

hash993

New Member
Joined
Dec 18, 2022
Messages
11
Office Version
  1. 365
Platform
  1. Windows
Hello everyone,

this code is working properly"ish" the only issue when it opens outlook it opens two new emails not one.
then pop up " Reference isn't valid " then a second pop up "click row number #"

VBA Code:
Sub addlinks()
    Dim lastrow As String
    
    lastrow = Cells(Rows.Count, 1).End(xlDown).Row

    For i = 3 To lastrow
        If Range("e" & i).Value <> "" Then

        
              ActiveSheet.Hyperlinks.Add Range("Z" & i), Address:="", SubAddress:="CreateEmailWithHTMLBody()", TextToDisplay:="Run Macro"
              
        End If
    Next
End Sub
Function CreateEmailWithHTMLBody()

    Dim objOutlook As Object
    Dim objMail As Object

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

    With objMail
        .To = "recipient@example.com"
        .Subject = "This is the subject" 

        'Set the HTML body of the email.
        .HTMLBody = "<html><body>This is the <b>HTML</b> body of the email.</body></html>"

        .Display 'Display the email before sending it.
    End With

    Set objMail = Nothing
    Set objOutlook = Nothing
    Exit Function
End Function
 
Posting code within code tags is preferred. Pictures are often too small to read code and no one can copy/paste to test.
You only get links where the other column is not blank as you say, BUT you are checking over a million rows with your way, so inefficient. Take out the IF and run it and you'll get over a million links.

If that's all the code you have in the whole project then I have no other suggestions, except I would take a look if you upload a copy somewhere.
This is the full code as am experimenting on it:
VBA Code:
Sub addlinks()
    Dim lastrow As String
    
    lastrow = Cells(Rows.Count, 1).End(xlDown).Row

    For i = 3 To lastrow
        If Range("e" & i).Value <> "" Then

        
              ActiveSheet.Hyperlinks.Add Range("Z" & i), Address:="", SubAddress:="CreateEmailWithHTMLBody()", TextToDisplay:="Run Macro"
              
        End If
    Next
End Sub
Function CreateEmailWithHTMLBody()

    Dim objOutlook As Object
    Dim objMail As Object

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

    With objMail
        .To = "recipient@example.com"
        .Subject = "This is the subject" 

        'Set the HTML body of the email.
        .HTMLBody = "<html><body>This is the <b>HTML</b> body of the email.</body></html>"

        .Display 'Display the email before sending it.
    End With

    Set objMail = Nothing
    Set objOutlook = Nothing
    Exit Function
End Function

The code might not be efficient my knowledge in vba is very limited. What am trying to do.
- in the first few columns i’ll have employees data ( name - position - email ).
- second step vba code to check rows with employees data inserted “ in my case thats why i have the if for column E ( to check if there is email )
- third step is hyperlink in column Z in every row to issue HTML body email that contains data from same row.

Note: i used to have fully functioning code using mailto/vba but i could incorporate tables in the emails ( strictly texts ) I’ll happily share the code if needed.
 
Upvote 0

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Is there any code in module Sheet1?
this is the only code in the whole workbook, and to double make sure i made a new workbook and pasted the code. also on different devices.
the code is working but the issue is it excutes twice, then reference isn't valid. i will share a code for what i used to work on ( fully functional but i can't insert a table in it which is required )

VBA Code:
Sub addLinks()


Dim theName As String
Dim thePosition As String
Dim theEmail As String
Dim theProject As String
Dim nationalID As String
Dim jobCode As String
Dim costCenter As String
Dim dobeng As Date
Dim dobar As Date
Dim department As String
Dim company As String
Dim location As String



Dim lastrow As String


lastrow = Cells(Rows.Count, 1).End(xlDown).Row

For i = 3 To lastrow
If Range("g" & i).Value <> "" Then

theName = Range("C" & i).Value
thePosition = Range("D" & i).Value
theEmail = Range("G" & i).Value
theProject = Range("I" & i).Value
nationalID = Range("F" & i).Value
jobCode = Range("M" & i).Value
costCenter = Range("N" & i).Value
dobeng = Range("O" & i).Value
dobar = Range("P" & i).Value
department = Range("K" & i).Value
company = Range("L" & i).Value
location = Range("J" & i).Value




msgLink = "mailto:" & theEmail & "?subject=" & "Virtual job interview invitation - " & theName & " - " & theProject & " - " & thePosition & " - " & department & "&cc=" & "email@email.com" & "&" & "body=" & "Dear " & theName & ",%0A%0AThank you for your interest in joining company%0A In the below, it is your interview appointment schedule details: %0A %0AJob title: " & thePosition & ".%0AWork location: " & location & "%0ADate: ( ENTER DATE )%0ATime: ( ENTER TIME )%0A%0APlease attend 10 minutes before interview appointment. %0AInterview Location: Video Microsoft Teams -The link is on the bottom of this email.%0A%0APlease confirm your attendance by replying to this email.  "

ActiveSheet.Hyperlinks.Add Range("T" & i), Address:=(msgLink), TextToDisplay:="Send"

           Else
            Exit For ' Exit the loop if there's no email address
End If


Next

i want to do the same, just with HTML body to be able to include tables.
 
Upvote 0
The "Row 5 is clicked" msgbox is not generated by Excel. Therefore it has to be generated by your code, or code in an add-in, or other code somewhere. Until we can find out what other code is being executed it may not be possible to diagnose.

If you have a way to share your file I will try to reproduce the problem. Or if you describe your data layout in detail so I can at least try to mock up a file like yours.
 
Upvote 0
I made the same offer back in post 9. Nothing has changed since then that would enable me to add anything new. Since there's no other code I guess it can't be caused by not using Application.EnableEvents = False in any of the posted code so no new ideas.
 
Upvote 0
I have to go out in 20 minutes so I will check this afternoon to see if you have a solution already.
 
Upvote 0
My ride is late so I took a look. Have an idea but no time. Need to know: what distinguishes one email from the other? Regardless of which link I choose, I get the same recipient.
 
Upvote 0
My ride is late so I took a look. Have an idea but no time. Need to know: what distinguishes one email from the other? Regardless of which link I choose, I get the same recipient.
True that 🤣 i was gonna get to it on my next to do list. I understand this is not doing what i want. My other code does.. but trying to find a way to automate the process a bit further by including tables which is impossible using “mailto” function. Any clue how should i go around that.
For example each row will have different inputs that will be used in email. My VBA knowledge is near zero. I grasp few basic of coding but never understood it.

Am trying to do this to automate the many emails i send and my department sends on daily basis. While minimizing human errors
 
Upvote 0
Am trying to do this to automate the many emails i send and my department sends on daily basis.
Then I think I'd be abandoning the hyperlink idea as there are better ways. However, your solution for this issue might be as follows:
- don't use subaddress, use
ActiveSheet.Hyperlinks.Add Range("Z" & i), Address:="", TextToDisplay:="Run Macro"
- and put this at the sheet level
VBA Code:
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
CreateEmailWithHTMLBody
End Sub
Why the hyperlink initiates 2 emails I don't know, but from what I've read it's not the preferred method.

I imagine you have a lot left to do, such as use sheet cell values for the recipient, bcc and so on. Those I might pass to the email sub but that would require you to add parameters to it. Maybe that would be Target.TextToDisplay, Address (that's email address) or .RecipientName if something useful other than RunMacro was used.

As to how to put a table in an email, I was just looking at that the other day (can't recall whose thread it was) but it has been asked and answered elsewhere. Maybe try searching on that subject because I didn't get too involved in it.
 
Upvote 0

Forum statistics

Threads
1,215,004
Messages
6,122,656
Members
449,091
Latest member
peppernaut

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