E
Eric
Hi everyone. The below code works great (can't remember
who to thank), but how do I put a hyperlink into a the
body of a email? I am using Lotus Notes R5.
Public Function SendMail(strName As String, strFileName As
String, strLocation As String)
'Added 10-11-2004 by EB
'Goes along with btnForgotPassword
Dim fileNames(2) As String
Dim sendTo(1) As String
Dim Subject As String
Dim message As String
Dim CarbonCopy As String
sendTo(0) = "Eric Brenner"
sendTo(1) = "James Kring"
fileNames(0) = ""
fileNames(1) = ""
fileNames(2) = ""
CarbonCopy = strName
Subject = "Please reset password for " & strName
message = "Please do not respond to this email." & Chr
(13) & Chr(13) & "Please reset the password for " &
strName & " in the Docunment Center. "
If sendFiles(fileNames, sendTo, Subject, message,
CarbonCopy) Then
'MsgBox "Message has been sent to a Quality
Information Specialist.", vbOKOnly, "Forgot Password
Notification Sent"
MsgBox "Message has been sent to " & sendTo(0) & "
and " & sendTo(1) & ".", vbOKOnly, "Forgot Password
Notification Sent"
Else
MsgBox "Could not send email."
End If
End Function
Public Function sendFiles(fileNames As Variant, sendTo As
Variant, Subject As _
String, message As String, Optional CarbonCopy As String)
As Boolean
On Error Resume Next
' (c) Rob Appelboom, Dec 2001
' Uploads files to a notes databasae and sends it to a
couple of people
' FileNames : array of filepaths
' sendTo : array of users or groups to send to
' subject: header of the e-mail
' Uses an OLE/2 session with Notes 4.6 or 5.x
sendFiles = False
Dim ses As Object ' Notes session
Const MACRO_TITLE = "Send Files" ' Title of message
boxes
If Subject = "" Then
MsgBox "Please specify a subject.", vbCritical,
MACRO_TITLE
Exit Function
End If
' Notes session Start
On Error GoTo NotesError
Set ses = GetObject("", "Notes.NotesSession")
GoTo NotesOk
NotesError:
MsgBox "Could not start Lotus Notes. Please make sure
Lotus Notes Version 4.6, 5 or higher is installed.",
vbCritical, MACRO_TITLE
Resume EndOfSub
NotesOk:
On Error GoTo 0
' Notes Session End
' Open Mail Database Start
Dim mailServer As String
Dim MailFile As String
On Error GoTo NoMailDB
mailServer = ses.GETENVIRONMENTSTRING("MailServer",
True)
MailFile = ses.GETENVIRONMENTSTRING("MailFile", True)
If MailFile = "" Then
MsgBox "Your Lotus Notes client is not setup
correctly: Please specify your mail database in the
location document.", vbCritical, MACRO_TITLE
GoTo EndOfSub
End If
Dim dbMail As Object
Set dbMail = ses.GETDATABASE("", "")
Call dbMail.OPENMAIL
If dbMail Is Nothing Then
'MsgBox "Mail database " + MailFile + " on server "
+ mailServer + " could not be opened. Please specify your
mail database in the location document of Lotus Notes.",
vbCritical, MACRO_TITLE
GoTo EndOfSub
End If
GoTo MailDBOpen
NoMailDB:
'MsgBox "Mail database " + MailFile + " on server " +
mailServer + " could not be opened. Please specify your
mail database in the location document of Lotus Notes.",
vbCritical, MACRO_TITLE
Resume EndOfSub
MailDBOpen:
On Error GoTo 0
' Open Mail database end
' Get username
Dim UserName As Object
Set UserName = ses.CREATENAME(ses.UserName)
' Create E-mail Start
' Create e-mail and attach the file with the sheet with
addresses hidden
On Error GoTo MailError
Dim docMail As Object
Set docMail = dbMail.CREATEDOCUMENT
' Call docMail.Save(True, False)
'Set dbMail = Nothing
docMail.Form = "Memo"
Call docMail.APPENDITEMVALUE("subject", Subject)
Dim itmSendTo As Object
Dim ii%
For ii = LBound(sendTo) To UBound(sendTo)
If (ii = LBound(sendTo)) Then
Set itmSendTo = docMail.APPENDITEMVALUE
("sendTo", sendTo(ii))
Else
Call itmSendTo.APPENDTOTEXTLIST(sendTo(ii))
End If
Next ii
docMail.copyTo = CarbonCopy
docMail.blindCopyTo = ""
docMail.PostedDate = Now()
Dim rtiMail As Object
Set rtiMail = docMail.CREATERICHTEXTITEM("body")
Call rtiMail.APPENDTEXT(message)
Call rtiMail.ADDNEWLINE(2, True)
For ii = LBound(fileNames) To UBound(fileNames)
On Error GoTo AttachError
Call rtiMail.EMBEDOBJECT(1454, "", fileNames(ii))
GoTo AttachOk
AttachError:
'MsgBox "File " + fileNames(ii) + " could not be
found or read.", vbCritical, MACRO_TITLE
Resume AttachOk
AttachOk:
On Error GoTo 0
Next ii
GoTo MailOk
MailError:
'MsgBox "E-Mail could not be created (maildatabase: " +
MailFile + ").", vbCritical, MACRO_TITLE
Resume EndOfSub
MailOk:
On Error GoTo 0
' Create E-mail End
' Send & Save E-mail Start
On Error GoTo SendError
Call docMail.SEND(False, sendTo) ' Send
the e-mail off
Call docMail.Save(True, False)
GoTo SendOk
SendError:
MsgBox "E-Mail created but could not be sent out.
(maildatabase: " + MailFile + ").", vbCritical, MACRO_TITLE
Resume EndOfSub
SendOk:
On Error GoTo 0
' Create E-mail End
sendFiles = True
EndOfSub:
On Error GoTo 0
If Not ses Is Nothing Then Call ses.Close
' Delete pointers
Set ses = Nothing
End Function
who to thank), but how do I put a hyperlink into a the
body of a email? I am using Lotus Notes R5.
Public Function SendMail(strName As String, strFileName As
String, strLocation As String)
'Added 10-11-2004 by EB
'Goes along with btnForgotPassword
Dim fileNames(2) As String
Dim sendTo(1) As String
Dim Subject As String
Dim message As String
Dim CarbonCopy As String
sendTo(0) = "Eric Brenner"
sendTo(1) = "James Kring"
fileNames(0) = ""
fileNames(1) = ""
fileNames(2) = ""
CarbonCopy = strName
Subject = "Please reset password for " & strName
message = "Please do not respond to this email." & Chr
(13) & Chr(13) & "Please reset the password for " &
strName & " in the Docunment Center. "
If sendFiles(fileNames, sendTo, Subject, message,
CarbonCopy) Then
'MsgBox "Message has been sent to a Quality
Information Specialist.", vbOKOnly, "Forgot Password
Notification Sent"
MsgBox "Message has been sent to " & sendTo(0) & "
and " & sendTo(1) & ".", vbOKOnly, "Forgot Password
Notification Sent"
Else
MsgBox "Could not send email."
End If
End Function
Public Function sendFiles(fileNames As Variant, sendTo As
Variant, Subject As _
String, message As String, Optional CarbonCopy As String)
As Boolean
On Error Resume Next
' (c) Rob Appelboom, Dec 2001
' Uploads files to a notes databasae and sends it to a
couple of people
' FileNames : array of filepaths
' sendTo : array of users or groups to send to
' subject: header of the e-mail
' Uses an OLE/2 session with Notes 4.6 or 5.x
sendFiles = False
Dim ses As Object ' Notes session
Const MACRO_TITLE = "Send Files" ' Title of message
boxes
If Subject = "" Then
MsgBox "Please specify a subject.", vbCritical,
MACRO_TITLE
Exit Function
End If
' Notes session Start
On Error GoTo NotesError
Set ses = GetObject("", "Notes.NotesSession")
GoTo NotesOk
NotesError:
MsgBox "Could not start Lotus Notes. Please make sure
Lotus Notes Version 4.6, 5 or higher is installed.",
vbCritical, MACRO_TITLE
Resume EndOfSub
NotesOk:
On Error GoTo 0
' Notes Session End
' Open Mail Database Start
Dim mailServer As String
Dim MailFile As String
On Error GoTo NoMailDB
mailServer = ses.GETENVIRONMENTSTRING("MailServer",
True)
MailFile = ses.GETENVIRONMENTSTRING("MailFile", True)
If MailFile = "" Then
MsgBox "Your Lotus Notes client is not setup
correctly: Please specify your mail database in the
location document.", vbCritical, MACRO_TITLE
GoTo EndOfSub
End If
Dim dbMail As Object
Set dbMail = ses.GETDATABASE("", "")
Call dbMail.OPENMAIL
If dbMail Is Nothing Then
'MsgBox "Mail database " + MailFile + " on server "
+ mailServer + " could not be opened. Please specify your
mail database in the location document of Lotus Notes.",
vbCritical, MACRO_TITLE
GoTo EndOfSub
End If
GoTo MailDBOpen
NoMailDB:
'MsgBox "Mail database " + MailFile + " on server " +
mailServer + " could not be opened. Please specify your
mail database in the location document of Lotus Notes.",
vbCritical, MACRO_TITLE
Resume EndOfSub
MailDBOpen:
On Error GoTo 0
' Open Mail database end
' Get username
Dim UserName As Object
Set UserName = ses.CREATENAME(ses.UserName)
' Create E-mail Start
' Create e-mail and attach the file with the sheet with
addresses hidden
On Error GoTo MailError
Dim docMail As Object
Set docMail = dbMail.CREATEDOCUMENT
' Call docMail.Save(True, False)
'Set dbMail = Nothing
docMail.Form = "Memo"
Call docMail.APPENDITEMVALUE("subject", Subject)
Dim itmSendTo As Object
Dim ii%
For ii = LBound(sendTo) To UBound(sendTo)
If (ii = LBound(sendTo)) Then
Set itmSendTo = docMail.APPENDITEMVALUE
("sendTo", sendTo(ii))
Else
Call itmSendTo.APPENDTOTEXTLIST(sendTo(ii))
End If
Next ii
docMail.copyTo = CarbonCopy
docMail.blindCopyTo = ""
docMail.PostedDate = Now()
Dim rtiMail As Object
Set rtiMail = docMail.CREATERICHTEXTITEM("body")
Call rtiMail.APPENDTEXT(message)
Call rtiMail.ADDNEWLINE(2, True)
For ii = LBound(fileNames) To UBound(fileNames)
On Error GoTo AttachError
Call rtiMail.EMBEDOBJECT(1454, "", fileNames(ii))
GoTo AttachOk
AttachError:
'MsgBox "File " + fileNames(ii) + " could not be
found or read.", vbCritical, MACRO_TITLE
Resume AttachOk
AttachOk:
On Error GoTo 0
Next ii
GoTo MailOk
MailError:
'MsgBox "E-Mail could not be created (maildatabase: " +
MailFile + ").", vbCritical, MACRO_TITLE
Resume EndOfSub
MailOk:
On Error GoTo 0
' Create E-mail End
' Send & Save E-mail Start
On Error GoTo SendError
Call docMail.SEND(False, sendTo) ' Send
the e-mail off
Call docMail.Save(True, False)
GoTo SendOk
SendError:
MsgBox "E-Mail created but could not be sent out.
(maildatabase: " + MailFile + ").", vbCritical, MACRO_TITLE
Resume EndOfSub
SendOk:
On Error GoTo 0
' Create E-mail End
sendFiles = True
EndOfSub:
On Error GoTo 0
If Not ses Is Nothing Then Call ses.Close
' Delete pointers
Set ses = Nothing
End Function