Using VBA to automatically send Lotus Notes email with multiple attachments

[kidwispa]

Hi All,

Following on from this thread, where (with your expertise) I have managed to create multiple workbooks and save to a specific directory. Now comes the tricky part - what I would like to do is take ALL of the files from that directory, create an email in Lotus Notes and attach all files, and send to multiple recipients.

Can anyone help with this? I have searched on Google however given my limited knowledge of VBA I don't think I'd have much joy getting it to work!

Thanks in advance

Craig

 

[John Davis]

Hi All,

Following on from this thread, where (with your expertise) I have managed to create multiple workbooks and save to a specific directory. Now comes the tricky part - what I would like to do is take ALL of the files from that directory, create an email in Lotus Notes and attach all files, and send to multiple recipients.

Can anyone help with this? I have searched on Google however given my limited knowledge of VBA I don't think I'd have much joy getting it to work!

Thanks in advance

Craig

Craig:

I got this code from Smitty, on the board here. I can't remember who actually wrote it, but perhaps, you modify it for what you're trying too do.

Sub kidwispa()
'

Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
Dim ccRecipient As String
Dim Attachment1 As String
Dim Attachment2 As String
Dim Attachment3 As String
Dim Attachment4 As String
Dim Attachment5 As String
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim AttachME2 As Object
Dim AttachME3 As Object
Dim AttachME4 As Object
Dim AttachME5 As Object
Dim Session As Object
Dim EmbedObj1 As Object
Dim EmbedObj2 As Object
Dim EmbedObj3 As Object
Dim EmbedObj4 As Object
Dim EmbedObj5 As Object
Dim stSignature As String

With Application
.ScreenUpdating = False
.DisplayAlerts = False

' Open and locate current LOTUS NOTES User

Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If

' Create New Mail and Address Title Handlers

Set MailDoc = Maildb.CREATEDOCUMENT

MailDoc.Form = "Memo"

stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
' Select range of e-mail addresses
Recipient = Array("Joe_Boe@somewhere.com", "kristen_Dean@somewhere.com", "john_doe@somewhereelse.com", "jane.doe@anotherplace.com")
MailDoc.SendTo = Recipient
MailDoc.Subject = "PUT YOUR SUBJECT HERE"
MailDoc.Body = _
"Now is the time for all good men to come too the aid of their country"
' Select Workbook to Attach to E-Mail

MailDoc.SaveMessageOnSend = True
Attachment1 = "D:\common\data\excel\Attachment1.xls" '"C:\YourFile.xls" ' Required File Name

If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", "D:\common\data\excel\Attachment1.xls", "") 'Required File Name
On Error Resume Next
End If

Attachment2 = "D:\common\data\excel\Attachment2.xls" '"C:\YourFile.xls" ' Required File Name

If Attachment2 <> 0 Then
On Error Resume Next
Set AttachME2 = MailDoc.CREATERICHTEXTITEM("attachment2")
Set EmbedObj2 = AttachME.embedobject(1454, "attachment2", "D:\common\data\excel\Attachment2.xls", "") 'Required File Name
On Error Resume Next
End If

Attachment3 = "D:\common\data\excel\Attachment3.xls" '"C:\YourFile.xls" ' Required File Name

If Attachment3 <> "" Then
On Error Resume Next
Set AttachME3 = MailDoc.CREATERICHTEXTITEM("attachment3")
Set EmbedObj3 = AttachME.embedobject(1454, "attachment3", "D:\common\data\excel\Attachment3.xls", "") 'Required File Name
On Error Resume Next
End If

Attachment4 = "D:\common\data\excel\Attachment4.xls" '"C:\YourFile.xls" ' Required File Name

If Attachment4 <> "" Then
On Error Resume Next
Set AttachME4 = MailDoc.CREATERICHTEXTITEM("attachment4")
Set EmbedObj4 = AttachME.embedobject(1454, "attachment4", "D:\common\data\excel\Attachment4.xls", "") 'Required File Name
On Error Resume Next
End If

Attachment5 = "D:\common\data\excel\Attachment5.xls" '"C:\YourFile.xls" ' Required File Name

If Attachment5 <> "" Then
On Error Resume Next
Set AttachME5 = MailDoc.CREATERICHTEXTITEM("attachment5")
Set EmbedObj5 = AttachME.embedobject(1454, "attachment5", "D:\common\data\excel\Attachment5.xls", "") 'Required File Name
On Error Resume Next
End If

MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set AttachME2 = Nothing
Set AttachME3 = Nothing
Set AttachME4 = Nothing
Set AttachME5 = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
Set EmbedObj2 = Nothing
Set EmbedObj3 = Nothing
Set EmbedObj4 = Nothing
Set EmbedObj5 = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
End With

errorhandler1:

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set AttachME2 = Nothing
Set AttachME3 = Nothing
Set AttachME4 = Nothing
Set AttachME5 = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
Set EmbedObj2 = Nothing
Set EmbedObj3 = Nothing
Set EmbedObj4 = Nothing
Set EmbedObj5 = Nothing

End Sub

 

[Ghostline]

I've a code like that but with no attach.

My problem is how to send to multiple email.
I've this code bellow is to send email's field in access but it only send to the first email only;

rst! --> test@test.com,test2@teste2.com

It can be 1, 2 or more;

---/---

Private Sub Command43_Click()
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim rst As DAO.Recordset
Dim strBody
'Dim strBody2
Dim vaRecipients As Variant
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fspenTextFile("L:\teste.txt", ForReading)
strBody = f.ReadAll
f.Close
Set rst = Form_RC_S_NC.RecordsetClone
rst.MoveFirst
Do While Not rst.EOF

SendTo1 = rst![Email]

ESubject = "Teste" & " " & rst![SAP] & " " & rst![Nome]

Dim Session As Object
Dim EmbedObj1 As Object
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
Recipient = SendTo1

MailDoc.SendTo = SendTo1

MailDoc.Subject = ESubject
MailDoc.Body = strBody
MailDoc.PostedDate = Now()
On Error GoTo errorhandler1

MailDoc.Send 0, SendTo1

MailDoc.Save = True

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
skip_email:
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Sub

[QUOTE="John Davis, post: 2740001, member: 83130"]Craig:

I got this code from Smitty, on the board here. I can't remember who actually wrote it, but perhaps, you modify it for what you're trying too do.

[code]
Sub kidwispa()
'

Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
Dim ccRecipient As String
Dim Attachment1 As String
Dim Attachment2 As String
Dim Attachment3 As String
Dim Attachment4 As String
Dim Attachment5 As String
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim AttachME2 As Object
Dim AttachME3 As Object
Dim AttachME4 As Object
Dim AttachME5 As Object
Dim Session As Object
Dim EmbedObj1 As Object
Dim EmbedObj2 As Object
Dim EmbedObj3 As Object
Dim EmbedObj4 As Object
Dim EmbedObj5 As Object
Dim stSignature As String

With Application
.ScreenUpdating = False
.DisplayAlerts = False

' Open and locate current LOTUS NOTES User

Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If

' Create New Mail and Address Title Handlers

Set MailDoc = Maildb.CREATEDOCUMENT

MailDoc.Form = "Memo"

stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
' Select range of e-mail addresses
Recipient = Array("Joe_Boe@somewhere.com", "kristen_Dean@somewhere.com", "john_doe@somewhereelse.com", "jane.doe@anotherplace.com")
MailDoc.SendTo = Recipient
MailDoc.Subject = "PUT YOUR SUBJECT HERE"
MailDoc.Body = _
"Now is the time for all good men to come too the aid of their country"
' Select Workbook to Attach to E-Mail

MailDoc.SaveMessageOnSend = True
Attachment1 = "D:\common\data\excel\Attachment1.xls" '"C:\YourFile.xls" ' Required File Name

If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", "D:\common\data\excel\Attachment1.xls", "") 'Required File Name
On Error Resume Next
End If

Attachment2 = "D:\common\data\excel\Attachment2.xls" '"C:\YourFile.xls" ' Required File Name

If Attachment2 <> 0 Then
On Error Resume Next
Set AttachME2 = MailDoc.CREATERICHTEXTITEM("attachment2")
Set EmbedObj2 = AttachME.embedobject(1454, "attachment2", "D:\common\data\excel\Attachment2.xls", "") 'Required File Name
On Error Resume Next
End If

Attachment3 = "D:\common\data\excel\Attachment3.xls" '"C:\YourFile.xls" ' Required File Name

If Attachment3 <> "" Then
On Error Resume Next
Set AttachME3 = MailDoc.CREATERICHTEXTITEM("attachment3")
Set EmbedObj3 = AttachME.embedobject(1454, "attachment3", "D:\common\data\excel\Attachment3.xls", "") 'Required File Name
On Error Resume Next
End If

Attachment4 = "D:\common\data\excel\Attachment4.xls" '"C:\YourFile.xls" ' Required File Name

If Attachment4 <> "" Then
On Error Resume Next
Set AttachME4 = MailDoc.CREATERICHTEXTITEM("attachment4")
Set EmbedObj4 = AttachME.embedobject(1454, "attachment4", "D:\common\data\excel\Attachment4.xls", "") 'Required File Name
On Error Resume Next
End If

Attachment5 = "D:\common\data\excel\Attachment5.xls" '"C:\YourFile.xls" ' Required File Name

If Attachment5 <> "" Then
On Error Resume Next
Set AttachME5 = MailDoc.CREATERICHTEXTITEM("attachment5")
Set EmbedObj5 = AttachME.embedobject(1454, "attachment5", "D:\common\data\excel\Attachment5.xls", "") 'Required File Name
On Error Resume Next
End If

MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set AttachME2 = Nothing
Set AttachME3 = Nothing
Set AttachME4 = Nothing
Set AttachME5 = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
Set EmbedObj2 = Nothing
Set EmbedObj3 = Nothing
Set EmbedObj4 = Nothing
Set EmbedObj5 = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
End With

errorhandler1:

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set AttachME2 = Nothing
Set AttachME3 = Nothing
Set AttachME4 = Nothing
Set AttachME5 = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
Set EmbedObj2 = Nothing
Set EmbedObj3 = Nothing
Set EmbedObj4 = Nothing
Set EmbedObj5 = Nothing

End Sub
[/code][/QUOTE]