Need to Embed Hyperlink in VBA Email (Lotus Notes)

[spiderjolly]

Hello,

I have the following code sending an email. I want the link following "Checklist location" in the body of the email to be a hyperlink, but right now it is pulling the link as text and cannot be clicked on. Can anyone suggest a way to change this code to create the hyperlink when the email is sent?

Thank you in advance for all help.
Cheers Sean


Sub SendWithLotus()
Worksheets("Reporting form").Select
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object
Dim stSubject As Variant, stAttachment As String
Dim vaRecipient As Variant, vaMsg As Variant

Const EMBED_ATTACHMENT As Long = 1454

'Get the name of the recipient from the user.
vaDepot = Range("AA1")



Range("J5").Select
Do Until Len(Trim(ActiveCell)) = 0
last_depot = ActiveCell
ActiveCell.Offset(1, 0).Select
Loop
If IsEmpty(last_depot) Then
last_depot = "unknown"
End If
stSubject = "Loading Quality Report " & Format(Now(), "dd mmm yyyy") & " from " & last_depot & " to " & Range("AA1")
Worksheets("Contacts").Activate
Range("A2").Select
vaMsg = ("AUTOMATIC GENERATED MESSAGE: --> " & stSubject & " is updated, please check the air hub and gateway discussion database")
'If the user has canceled the operation.
'Add the subject to the outgoing e-mail
'which also can be retrieved from the users
'in a similar way as above. Do Until ActiveCell.Value = Empty
Do Until IsEmpty(ActiveCell)
If ActiveCell.Value = vaDepot Then
vaRecipient = ActiveCell.Offset(0, 4).Value
End If

ActiveCell.Offset(1, 0).Select


If vaRecipient = "" Then GoTo EndLoop
Worksheets("Reporting form").Activate
'Get the message from the user.
'Retrieve the path and filename of the active workbook.
stAttachment = ActiveWorkbook.FullName
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
'Set obAttachment = noDocument.CreateRichTextItem("stAttachment")
'Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
'Add values to the created e-mail main properties.
With noDocument
.Visible = True
.Form = "Memo"
.SendTo = vaRecipient
.SendTo = vaRecipient
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
End With
'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, vaRecipient
End With
vaRecipient = Empty

'Release objects from the memory.
Set EmbedObject = Nothing
Set obAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing

EndLoop:




Worksheets("Contacts").Activate
Loop


'Activate Excel for the user.
AppActivate "Microsoft Excel"
Worksheets("Reporting form").Activate
MsgBox "Notification sent successfully!", vbInformation

Newname = Application.GetSaveAsFilename
If Newname = False Then Exit Sub
ThisWorkbook.SaveAs Filename:=Newname

End Sub

 

[John_w]

This sends an email containing a hyperlink, which you'll need to adapt for your situation. Note - I've had to add a space after every "<" character in the HTML string to prevent the forum rendering the HTML tags and spoiling my code.

Public Sub Send_HTML_Email()

    Const ENC_IDENTITY_8BIT = 1729
    
    Dim NSession As Object
    Dim NDatabase As Object
    Dim NStream As Object
    Dim NDoc As Object
    Dim NMIMEBody As Object
    Dim HTML As String
    
    HTML = "< html>" & _
            "< body>" & _
            "< p>Hyperlink: < a href='https://www.mrexcel.com/forum/excel-questions/'>Excel Questions< /a>< /p>" & _
            "< /body>" & _
            "< /html>"
    HTML = Replace(HTML, "< ", "<")
    
    Set NSession = CreateObject("Notes.NotesSession")
    Set NDatabase = NSession.GetDatabase("", "")
    If Not NDatabase.IsOpen Then NDatabase.OpenMail
    Set NStream = NSession.CreateStream
    NSession.ConvertMime = False
    
    Set NDoc = NDatabase.CreateDocument()
    With NDoc
        .Form = "Memo"
        .Subject = "Email subject"
<xps15.lotus@tiger2.f2s.com><xps15.lotus@tiger2.f2s.com@notesdomain>        .SendTo = "name@address.com"  'string for single recipient or array for multiple recipients
        
        Set NMIMEBody = .CreateMIMEEntity
        NStream.WriteText HTML
        NMIMEBody.SetContentFromText NStream, "text/html; charset=UTF-8", ENC_IDENTITY_8BIT
    
        .Send False
        .Save True, False, False
    End With
    
    NSession.ConvertMime = True
    Set NDoc = Nothing
    Set NSession = Nothing
    
End Sub

<xps15.lotus@tiger2.f2s.com><xps15.lotus@tiger2.f2s.com@notesdomain></xps15.lotus@tiger2.f2s.com@notesdomain></xps15.lotus@tiger2.f2s.com></xps15.lotus@tiger2.f2s.com@notesdomain></xps15.lotus@tiger2.f2s.com>

 

[spiderjolly]

thanks for this. My VBA is a bit rusty this days. Dont use it, lose it!!! How do I embed this into my existing vba code?

Cheers
Sean

 

[John_w]

Looks like it replaces the lines starting "'Instantiate the Lotus Notes COM's Objects.", without the Public Sub and End Sub lines, and using your email addresses and subject.