View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Andy Wiggins Andy Wiggins is offline
external usenet poster
 
Posts: 107
Default Email using Lotus Notes & FollowHyperlink

Here is some code that might help you.
It comes from
http://www.bygsoftware.com/Excel/VBA...otus_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 = " '' 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" wrote in message
...
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=" & "
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:" & "
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