Public Sub SendNotesMail_Multiples(strSubject As String, _
strAttachment As Variant, _
strTo As Variant, _
strCC As Variant, _
strBCC As Variant, _
strBodyText As String, _
Optional bolSaveIt As Boolean = True)
'***************************************************************************************************
'**Purpose: This code will send notes with attachments through Lotus Notes using VB/VBA OLE Automation
'**Arguments: Describe arguments and valid values.
' strSubject INPUT: Pass the subject line as a string
' strAttachment INPUT: Pass the list of files to send as an array;
' Strings are not valid, while they do not produce an error, only the first attachment will be attached.
' strTo INPUT: Pass the list of mail recipients as an array;
' strings are not valid, while they do not produce an error, only the first recipient will receive the note
' You can send either Email address or your Mailing list names
' strCC INPUT: Pass the list of carbon copy recipients as an array;
' strings are not valid, while they do not produce an error, only the first recipient will receive the note
' You can send either Email address or your Mailing list names
' strBCC INPUT: Pass the list of blind carbon copy recipients as an array;
' strings are not valid, while they do not produce an error, only the first recipient will receive the note
' You can send either Email address or your Mailing list names
' strBodyText INPUT: Pass the body of the message a string
' bolSaveIt INPUT: Pass a boolean to tell Notes to save the email in your SEND folder or not.
'
'**Running App: Specifically tested in MS Access 97; should work from any application
'**Destination App: Lotus Notes Release 5.0.10
'**Dependencies: Reference to "Lotus Domino Objects" domobj.tlb
' Lotus Notes must be active and initialized
' **Code can be modified to activate and initialize Lotus Notes but requires the user's specific
' Notes mail server name and mail\USERNAME.nsf filename
'**Creation: 07/30/2003
'**Version Date: 05/03/2004
'**Version: 1.1
'**Author: Gabe Luebben
'**Notes: Additional useful documentation:
' Generally: [URL unfurl="true"]http://www.tek-tips.com[/URL]
' Specifically: [URL unfurl="true"]http://www.tek-tips.com/gviewthread.cfm/lev2/4/lev3/32/pid/222/qid/38494[/URL]
' Copy of Lotus Notes redbook:
' **** DELETED FOR PRIVACY ****
'***************************************************************************************************'-------------------------------------------------------------
'This public sub will send a mail and attachment if neccessary to the recipient including
'the body text.
'Requires that notes client is installed on the system
Dim i As Integer
'Set up the objects required for Automation into lotus notes
Dim MailDb As Object 'the mail database
Dim username As String 'the current user's notes name
Dim MailDbName As String 'The current user's notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim session As Object 'Teh notes session
Dim EmbedObj As Object 'The embedded object (attachment)
'Start a session to notes
Set session = CreateObject("Notes.Notessession")
'Get the sessions username and then calculate the mail file name
'You may or may not need this as for MailDBName with some systems you
'can pass an empty string
username = session.username
MailDbName = Left$(username, 1) & Right$(username, (Len(username) - InStr(1, _
username, " "))) & ".nsf"
'Open the mail database in notes
Set MailDb = session.GETDATABASE("", MailDbName)
If MailDb.ISOPEN = True Then
'already open for mail
Else
MailDb.OPENMAIL
End If
'set up the new mail document
Set MailDoc = MailDb.CREATEDOCUMENT
With MailDoc
.Form = "Memo"
.SendTo = strTo
.Subject = strSubject
.Body = strBodyText
.CopyTo = strCC
.BlindCopyTo = strBCC
.SAVEMESSAGEONSEND = bolSaveIt
End With
'Set up the embedded object and attachment and attach it
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
For i = 0 To UBound(strAttachment)
If strAttachment(i) <> "" Then
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", strAttachment(i), "Attachment")
End If
Next i
'Send Document
MailDoc.SEND True, strTo
'Clean Up
Set MailDb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set session = Nothing
Set EmbedObj = Nothing
End SubPrivate Sub cmdEmail_Click()
Dim strFN As String
Dim strRecipients As Variant
Dim strCC As Variant
Dim strSubject As String
Dim strAttachments As Variant
Dim strBody As String
Dim strPath As String
Dim intCount As Integer
strPath = "G:\BCC\Agency\Stan\Remittances\"
strRecipients = Array("Loan Ops")
strCC = Array("NAM Supervisors")
strSubject = "E-Remit Funded today " & Format(Date, "mm/dd/yyyy") & " - " & Me.txtAgencyName & " (" & Me.txtAgency & ") - " & Format(Me.txtRemitDate, "mm/dd/yyyy") & " - Check: " & Format(Me.txtNTC, "Currency") & " - Total: " & Format(Me.txtTotalRemit, "currency")
strBody = "Here is the remit for " & Me.txtAgencyName & " (" & Me.txtAgency & ") dated " & Format(Me.txtRemitDate.Value, "mm/dd/yyyy") & " that funded today."
ReDim strAttachments(0 To 20)
intCount = 0
strFN = Dir(strPath & Me.txtAgency & "*.*")
Do While strFN <> ""
strAttachments(intCount) = strPath & strFN
intCount = intCount + 1
strFN = Dir
Loop
ReDim Preserve strAttachments(intCount)
SendNotesMail_Multiples strSubject, strAttachments, strRecipients, strCC, "", strBody, True
strFN = Dir(strPath & Me.txtAgency & "*.*")
Do While strFN <> ""
Name strPath & strFN As strPath & "To Archive\" & strFN
strFN = Dir
Loop
End SubPublic Sub SendNotesMail_Multiples(strSubject As String, _
strAttachment As Variant, _
strTo As Variant, _
strCC As Variant, _
strBCC As Variant, _
strBodyText As String, _
Optional bolSaveIt As Boolean = True)
'***************************************************************************************************
'**Purpose: This code will send notes with attachments through Lotus Notes using VB/VBA OLE Automation
'**Arguments: Describe arguments and valid values.
' strSubject INPUT: Pass the subject line as a string
' strAttachment INPUT: Pass the list of files to send as an array;
' Strings are not valid, while they do not produce an error, only the first attachment will be attached.
' strTo INPUT: Pass the list of mail recipients as an array;
' strings are not valid, while they do not produce an error, only the first recipient will receive the note
' You can send either Email address or your Mailing list names
' strCC INPUT: Pass the list of carbon copy recipients as an array;
' strings are not valid, while they do not produce an error, only the first recipient will receive the note
' You can send either Email address or your Mailing list names
' strBCC INPUT: Pass the list of blind carbon copy recipients as an array;
' strings are not valid, while they do not produce an error, only the first recipient will receive the note
' You can send either Email address or your Mailing list names
' strBodyText INPUT: Pass the body of the message a string
' bolSaveIt INPUT: Pass a boolean to tell Notes to save the email in your SEND folder or not.
'
'**Running App: Specifically tested in MS Access 97; should work from any application
'**Destination App: Lotus Notes Release 5.0.10
'**Dependencies: Reference to "Lotus Domino Objects" domobj.tlb
' Lotus Notes must be active and initialized
' **Code can be modified to activate and initialize Lotus Notes but requires the user's specific
' Notes mail server name and mail\USERNAME.nsf filename
'**Creation: 07/30/2003
'**Version Date: 05/03/2004
'**Version: 1.1
'**Author: Stan Paszt
'**Notes: Additional useful documentation:
' Generally: [URL unfurl="true"]http://www.tek-tips.com[/URL]
' Specifically: [URL unfurl="true"]http://www.tek-tips.com/gviewthread.cfm/lev2/4/lev3/32/pid/222/qid/38494[/URL]
' Copy of Lotus Notes redbook:
' **** DELETED FOR PRIVACY ****
'***************************************************************************************************'-------------------------------------------------------------
'This public sub will send a mail and attachment if neccessary to the recipient including
'the body text.
'Requires that notes client is installed on the system
Dim i As Integer
'Set up the objects required for Automation into lotus notes
Dim MailDb As NotesDatabase 'the mail database
Dim UserName As String 'the current user's notes name
Dim MailDbName As String 'The current user's notes mail database name
Dim MailDoc As NotesDocument 'The mail document itself
Dim AttachME As NotesRichTextItem 'The attachment richtextfile object
Dim LNSession As NotesSession 'The notes LNLNSession
Dim EmbedObj As Object 'The embedded object (attachment)
'Start a LNSession to notes
Set LNSession = New NotesSession
LNSession.Initialize
'Get the LNSessions username and then calculate the mail file name
'You may or may not need this as for MailDBName with some systems you
'can pass an empty string
UserName = LNSession.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, _
UserName, " "))) & ".nsf"
'Open the mail database in notes
Set MailDb = LNSession.URLDatabase
If MailDb.IsOpen = True Then
'already open for mail
Else
MailDb.Open
End If
'set up the new mail document
Set MailDoc = MailDb.CreateDocument
With MailDoc
.AppendItemValue "Form", "Memo"
.AppendItemValue "From", LNSession.CommonUserName
.AppendItemValue "SendTo", strTo
.AppendItemValue "Subject", strSubject
.AppendItemValue "Body", strBodyText
.AppendItemValue "CopyTo", strCC
.AppendItemValue "BlindCopyTo", strBCC
.AppendItemValue "SaveMessageOnSend", bolSaveIt
End With
'Set up the embedded object and attachment and attach it
Set AttachME = MailDoc.CreateRichTextItem("Attachment")
For i = 0 To UBound(strAttachment)
If strAttachment(i) <> "" Then
Set EmbedObj = AttachME.EmbedObject(1454, "", strAttachment(i), "Attachment")
End If
Next i
MailDoc.SaveMessageOnSend = True
'Send Document
MailDoc.Send True, strTo
'Clean Up
Set MailDb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set LNSession = Nothing
Set EmbedObj = Nothing
End SubPrivate Sub cmdEmail_Click()
Dim strFN As String
Dim strRecipients As Variant
Dim strCC As Variant
Dim strSubject As String
Dim strAttachments As Variant
Dim strBody As String
Dim strPath As String
Dim intCount As Integer
Dim strBCC As Variant
'The path for the files that will be attached
strPath = "G:\BCC\Agency\Stan\Remittances\"
'The Recipients of the email. You can send multiple email addresses.
strRecipients = Array("Loan Ops")
'The Carbon Copies of the email. You can send multiple email addresses.
strCC = Array("NAM Supervisors")
'The Blind Carbon Copies of the email. You can send multiple email addresses.
strBCC = Array("")
'This is the subject of the email.
strSubject = [This is where the subject goes]
'This is the body of the email. For long emails, you may want to split this into several lines.
strBody = [This is where the body of the email goes]
'Dimension the Attachment array. I arbitrarily chose 20, because I knew there would never be that many for the function.
ReDim strAttachments(0 To 20)
'This counts how many attachments are being arrayed so we can redim the array afterward.
intCount = 0
'This is where we get the files and put them in the array. You have to put the entire path in the array, or lotus wont be able to find them.
strFN = Dir(strPath & Me.txtAgency & "*.*")
Do While strFN <> ""
strAttachments(intCount) = strPath & strFN
intCount = intCount + 1
strFN = Dir
Loop
'Redimension the array so there are no empty parts.
ReDim Preserve strAttachments(intCount)
'Send the information to the SendNotesMail_Multiples procedure.
SendNotesMail_Multiples strSubject, strAttachments, strRecipients, strCC, strBCC, strBody, True
'This moves the files that I just emailed to another folder, so they don't get sent again.
strFN = Dir(strPath & Me.txtAgency & "*.*")
Do While strFN <> ""
Name strPath & strFN As strPath & "To Archive\" & strFN
strFN = Dir
Loop
End Sub
