Place a link in Body of a Notes-mail using Excel-VBA

[MeileB]

I searched a lot in this forum and on the internet for my problem, but not found it yet.

I'm using the following code (found on this forum) for sending a mail through Notes.
This code:
- attaches a file in the mail,
- select/activate the Notes-Memo,
- allows the user to edit the body before sending,
- will be copied to the "SendItems" after sending.

<o></o>

<o:p></o:p>[/FONT][/SIZE][/FONT][/COLOR]
[COLOR=#222222][FONT=Tahoma][FONT=Verdana][SIZE=2]Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Global Const SW_MAXIMIZE = 3
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWNORMAL = 1

Private Declare Function apiFindWindow Lib "user32" Alias _
"FindWindowA" (ByVal strClass As String, ByVal lpWindow As String) As Long
_______________________________________________________________________

'Script to open an email through Lotus Notes, attache a file.
[/SIZE][/FONT][/FONT][/COLOR][COLOR=#222222][FONT=Tahoma][FONT=Verdana][SIZE=2]Sub Create_Email()

Dim UserID As String
[/SIZE][/FONT][/FONT][/COLOR][COLOR=#222222][FONT=Tahoma][FONT=Verdana][SIZE=2]Dim MailDbName As String
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim EmbedObj1 As Object
Dim Workspace As Object
Dim objLN As Object
Dim lngH As Long

Set Session = CreateObject("Notes.NotesSession")
UserID = Session.UserName
MailDbName = Left$(UserID, 1) & Right$(UserID, (Len(UserID) - InStr(1, UserID, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)

If Maildb.IsOpen = True Then
Else
[/SIZE][/FONT][/FONT][/COLOR][SIZE=2][FONT=Verdana][COLOR=#222222][FONT=Tahoma]    Maildb.OPENMAIL
End If

[/FONT][/COLOR][COLOR=#222222][FONT=Tahoma]Set MailDoc = Maildb.CreateDocument[/FONT][/COLOR][/FONT][/SIZE][COLOR=#222222][FONT=Tahoma]
[/FONT][/COLOR][COLOR=#222222][FONT=Tahoma][FONT=Verdana][SIZE=2]MailDoc.Form = "Memo"
[/SIZE][/FONT][/FONT][/COLOR][COLOR=#222222][FONT=Tahoma][SIZE=2][FONT=Verdana]MailDoc.SendTo = ""
MailDoc.subject = "Formulier ter behandeling of ter informatie"
MailDoc.body = "Bijgaand, ter behandeling of ter informatie, een formulier."

MailDoc.SaveMessageOnSend = False
Bijlage = "C:\Map\" & ActiveWorkbook.Name

If Bijlage <> "" Then
    On Error Resume Next
    Set AttachME = MailDoc.CREATERICHTEXTITEM("Bijlage")
    Set EmbedObj1 = AttachME.embedobject(1454, "Bijlage", "C:\Map\" & ActiveWorkbook.Name)
    [/FONT][/SIZE][/FONT][/COLOR][COLOR=#222222][FONT=Tahoma][FONT=Verdana][SIZE=2]On Error Resume Next
End If

Set Workspace = CreateObject("Notes.NotesUIWorkspace")
Call Workspace.EDITDOCUMENT(True, MailDoc).GOTOFIELD("Body")

'Seleceteer LoNo als actief scherm
lngH = apiFindWindow("NOTES", vbNullString)
If lngH <> 0 Then apiShowWindow lngH, 1

'Set-acties ongedaan maken
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
[/SIZE][/FONT][/FONT][/COLOR][COLOR=#222222][FONT=Tahoma][FONT=Verdana][SIZE=2]Set EmbedObj1 = Nothing

'Set-acties ongedaan maken bij foutafhandeling
[/SIZE][/FONT][/FONT][/COLOR][COLOR=#222222][FONT=Tahoma][FONT=Verdana][SIZE=2]errorhandler1:

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
[/SIZE][/FONT][/FONT][/COLOR][COLOR=#222222][FONT=Tahoma][FONT=Verdana][SIZE=2]Set EmbedObj1 = Nothing

'Schermupdates en -meldingen weer aan zetten
[/SIZE][/FONT][/FONT][/COLOR][COLOR=#222222][FONT=Tahoma][SIZE=2][FONT=Verdana]With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

End Sub

<o></o>
<o> </o>
But I have two problems with this code.

1. I wish to send the mail using a html-link to the file on our company-server, instead of attaching the file in the mail.

I found the following code on this forum, but the code send the email directly instead of allowing the user to edit the body.

<o></o>

<o:p></o:p>[/FONT][/COLOR][/SIZE]
[FONT=Verdana][SIZE=2][COLOR=#000000]Sub Send_HTML_Email()

    Const ENC_IDENTITY_8BIT = 1729

    'Send Lotus Notes email containing links to files on local computer

Dim NSession As Object      'NotesSession
Dim NDatabase As Object     'NotesDatabase
Dim NStream As Object       'NotesStream
Dim NDoc As Object          'NotesDocument
Dim NMIMEBody As Object     'NotesMIMEEntity
Dim SendTo As String
Dim subject As String
Dim HTML As String, HTMLbody As String

SendTo = "email@email.com"
subject = Now & " Lotus Notes HTML MIME email"
Debug.Print subject

Set NSession = CreateObject("Notes.NotesSession")
Set NDatabase = NSession.GETDATABASE("", "")

If Not NDatabase.IsOpen Then NDatabase.OPENMAIL

[/COLOR][/SIZE][/FONT][FONT=Verdana][SIZE=2][COLOR=#000000]Set NStream = NSession.CreateStream

HTMLbody = "<p>Bijgaand een link naar ee[/COLOR][/SIZE][/FONT][SIZE=2][COLOR=#000000][FONT=Verdana]n instroom-formulier.</p>" & _
        "<a href='file:///C:\map\bestand.xlsm'>Klik hier om te openen.</><br>"

HTML = "<html>" & vbLf & _
        "<head>" & vbLf & _
        "****** http-equiv=""Content-Type"" content=""text/html; charset=UTF-8"" />" & vbLf & _
        "</head>" & vbLf & _
        "<body>" & vbLf & _
        HTMLbody & _
        "</body>" & vbLf & _
        "</html>"

NSession.ConvertMime = False     'Don't convert MIME to rich text

Set NDoc = NDatabase.CreateDocument()

With NDoc
    .Form = "Memo"
    .Subject = subject
    .SendTo = Split(SendTo, ",")

    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      'Restore conversion

Set NDoc = Nothing
Set NSession = Nothing

End Sub

<o></o>
<o> </o>
2. If the user has a signature in his/her email, the text of the body will be placed under the signature instead of above (on the first line).

I tried several changes that I searched on the forum, but until now I have no working solution.

Who can help me with this problem?

 

[Taramera]

Change

.Send False

to

.Display