Email using Lotus Notes & FollowHyperlink

[Glenn Ray]

I am trying to use the FollowHyperlink method to generate an email using the
default client. Works with Outlook, but not with Lotus Notes; it activates
Lotus Notes, but does not initiate an email message.

To test, I created a simplified version of the same routine in another
workbook and this second program DID work!

This may be a "forest for the trees" issue, but can anyone point out the
*significant* differences between the two routines that would prevent the
first from working? (I mean, besides the first set of nested IF Then...Else
statements at the start of the first routine)

Thanks in advance
- Glenn Ray

========First Routine (not working) ===========
'This is a Click event inside a user form (frmRejectEmail)
Option Explicit
Dim stext, sAddedtext As String

Private Sub btnSend_Click()
frmRejectEmail.Hide
boolRej = True
On Error GoTo Err_Send_Click

If frmRejectEmail.chSuprCC.Value = True Then
If Range("SuprEmail").Value = Range("UserEmail").Value Then
sAddedtext = "&BCC=" & Range("SuprEmail").Value
Else
sAddedtext = "&CC=" & Range("SuprEmail").Value
sAddedtext = sAddedtext & "&BCC=" & Range("UserEmail").Value
End If
End If
sAddedtext = sAddedtext & "&Subject=" & frmRejectEmail.lblSubject.Caption
sAddedtext = sAddedtext & "&Body=" & frmRejectEmail.lblDefaultMsg.Caption
If frmRejectEmail.txtMsgBody.Value <> "" Then
sAddedtext = sAddedtext & " - " & frmRejectEmail.txtMsgBody.Value
End If

stext = "mailto:" & strEmail
Mid$(sAddedtext, 1, 1) = "?"
stext = stext & sAddedtext

ThisWorkbook.FollowHyperlink stext

Exit_Send_Click:
Exit Sub

Err_Send_Click:
MsgBox Err.Description & vbLf & "Contact Glenn Ray for assistance."
Resume Exit_Send_Click

End Sub

=======Second routine (works)==============
Option Explicit
Dim strtext As String
Dim chSuprCC As Boolean
Const strMsgBody as String = "And another thing..."
Sub Send_mail2()
On Error GoTo Err_Send_Click
chSuprCC = True
Dim stext As String
Dim sAddedtext As String
If chSuprCC = True Then
sAddedtext = "&BCC=" & "(e-mail address removed)"
End If
sAddedtext = sAddedtext & "&Subject=" & "this is the subject"
sAddedtext = sAddedtext & "&Body=" & "you messed up and this is what
you're gonna do about it"
If strMsgBody <> "" Then
sAddedtext = sAddedtext & " - " & vbCrLf & vbCrLf & strMsgBody
End If

stext = "mailto:" & "(e-mail address removed)"
Mid$(sAddedtext, 1, 1) = "?"
stext = stext & sAddedtext

ThisWorkbook.FollowHyperlink stext

Exit_Send_Click:
Exit Sub

Err_Send_Click:
MsgBox Err.Description
Resume Exit_Send_Click

End Sub

 

[Andy Wiggins]

Here is some code that might help you.
It comes from
http://www.bygsoftware.com/Excel/VBA/email_from_lotus_notes.htm
Open a new module and paste in this code:

Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object

Function SendMail()

On Error GoTo SendMailError

EMailSendTo = "(e-mail address removed)" '' Required - Send to address
EMailCCTo = "" '' Optional
EMailBCCTo = "" '' Optional

''Establish Connection to Notes
Set objNotesSession = CreateObject("Notes.NotesSession")

''Establish Connection to Mail File
'' .GETDATABASE("SERVER", "FILE")
Set objNotesMailFile = objNotesSession.GETDATABASE("", "")
''Open Mail
objNotesMailFile.OPENMAIL

''Create New Memo
Set objNotesDocument = objNotesMailFile.CREATEDOCUMENT

''Create 'Subject Field'
Set objNotesField = objNotesDocument.APPENDITEMVALUE("Subject",
EMailSubject)

''Create 'Send To' Field
Set objNotesField = objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)

''Create 'Copy To' Field
Set objNotesField = objNotesDocument.APPENDITEMVALUE("CopyTo", EMailCCTo)

''Create 'Blind Copy To' Field
Set objNotesField = objNotesDocument.APPENDITEMVALUE("BlindCopyTo",
EMailBCCTo)

''Create 'Body' of memo
Set objNotesField = objNotesDocument.CREATERICHTEXTITEM("Body")

With objNotesField
.APPENDTEXT "This e-mail is generated by an automated process."
.ADDNEWLINE 1
.APPENDTEXT "Please follow established contact procedures should you
have any questions."
.ADDNEWLINE 2
End With

''Attach the file --1454 indicate a file attachment
''objNotesField = objNotesField.EMBEDOBJECT(1454, "", "C:\Temp\test.xls")
objNotesField = objNotesField.EMBEDOBJECT(1454, "", ActiveWorkbook.FullName)

''Send the e-mail
objNotesDocument.Send (0)

''Release storage
Set objNotesSession = Nothing
Set bjNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing

''Set return code
SendMail = True

Exit Function

SendMailError:
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext

SendMail = False

End Function

--
Regards
-
Andy Wiggins FCCA
www.BygSoftware.com
Excel, Access and VBA Consultancy

 

[Glenn Ray]

Hi Andy,

I'm familiar with that code, having seen it in other threads in the
Excel.programming newsgroup. Unfortunately, I have no way of determining the
default e-mail client. I tried using Application.MailSystem, but it does not
work (returns a value of "1", same as xlMAPI).

I would consider using CDO (see Ron de Bruin's site), but would need to find
a way to locate the SMTP server for each user (this application will be run
across several networks).

I've snipped out the original code I presented earlier and will try to
restate my request. I have two sets of code designed to launch an e-mail
event using Application.FollowHyperlink. Both build a "mailto" string and
both work with MS Outlook. However, only the second one works with Lotus
Notes. Does anyone see a reason why the first one would not work with Lotus
Notes (ex. in a userform module?)

=======First Routine (does not work with Lotus Notes)========
Private Sub btnSend_Click()
boolRej = True
If frmRejectEmail.chSuprCC.Value = True Then
If Range("SuprEmail").Value = Range("UserEmail").Value Then
sAddedtext = "&BCC=" & Range("SuprEmail").Value
Else
sAddedtext = "&CC=" & Range("SuprEmail").Value
sAddedtext = sAddedtext & "&BCC=" & Range("UserEmail").Value
End If
End If
sAddedtext = sAddedtext & "&Subject=" & frmRejectEmail.lblSubject.Caption
sAddedtext = sAddedtext & "&Body=" & frmRejectEmail.lblDefaultMsg.Caption
If frmRejectEmail.txtMsgBody.Value <> "" Then
sAddedtext = sAddedtext & " - " & frmRejectEmail.txtMsgBody.Value
End If

stext = "mailto:" & strEmail
Mid$(sAddedtext, 1, 1) = "?"
stext = stext & sAddedtext
ThisWorkbook.FollowHyperlink stext
frmRejectEmail.Hide
End Sub

======Second routine (works with Lotus Notes)======
Sub Send_mail2()
Dim chSuprCC As Boolean
Dim stext, sAddedtext As String
chSuprCC = True
If chSuprCC = True Then
sAddedtext = "&BCC=" & "(e-mail address removed)"
End If
sAddedtext = sAddedtext & "&Subject=" & "this is the subject"
sAddedtext = sAddedtext & "&Body=" & "you messed up and this is what
you're gonna do about it"
If "and another thing" <> "" Then
sAddedtext = sAddedtext & " - " & vbCrLf & vbCrLf & "and another
thing: Don't ask questions"
End If

stext = "mailto:" & "(e-mail address removed)"
Mid$(sAddedtext, 1, 1) = "?"
stext = stext & sAddedtext
ThisWorkbook.FollowHyperlink stext
End Sub