Stuck on Mailing attachments

[froggiebeckie]

Hi, all!!

I need to generate 1 email with 3 attachments from an Access Db. These attachments are canned reports that are generated each week with fresh data.

I've done several searches and found a lot of good information here. Based on what I've read, I decided to output the 3 reports to a folder in My Documents and then automate Outlook to send the message.

I've used the output function to create the 3 files. No Problem, works well.

Then I found this code for automating Outlook. (Pasted below)
I can get it to work (following either step 7 or step 8 below) but only if I include the attachment path in the SendMessage command.

Assuming the full paths are:
C:\My Documents\Report1.snp
C:\My Documents\Report2.snp
C:\My Documents\Report3.snp

how do I modify the code to automatically attach all 3 files?

Any ideas?
As always, thanks for taking the time to help,
BeckieO


Sub SendMessage(Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment

' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")

' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Henny Penny")
objOutlookRecip.Type = olTo

' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Lucky Ducky")
objOutlookRecip.Type = olCC

' Set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "Last test - I promise." & vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance

' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If

' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send

End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub


7. To test this procedure, type the following line in the Immediate window, and then press ENTER: SendMessage "C:\My Documents\Customers.txt"

8. To send the message without specifying an attachment, omit the argument when calling the procedure, as follows:SendMessage

 

[Alc]

The following works for me.
Note, the code assumes
1) It is in a function and that it has variables str_Subject (mail subject) and str_Body (body text of mail) passed into it as Strings.
2) ALL files in the stated folder (SendFiles) are to be attached.

Hope it helps.

Dim NameSpace As Object
Dim EmailSend As MailItem
Dim EmailApp As Object
Dim str_Source_Path As String
Dim str_File_Name As String

    str_Source_Path = "C:\My Documents\SendFiles"

    Set EmailApp = CreateObject("Outlook.Application")
    Set ObjeOutlookMsg = EmailApp.GetNamespace("MAPI")
    Set EmailSend = EmailApp.CreateItem(0)

    EmailSend.Subject = str_Subject
    EmailSend.Body = str_Body

    'Loop and attach all files from this folder
    '-------------------------------------------
    str_File_Name = Dir(str_Source_Path)
    Do While str_File_Name <> ""
        EmailSend.Attachments.Add (str_Source_Path & str_File_Name)
        str_File_Name = Dir
    Loop
    
    EmailSend.readreceiptrequested = lb_ReadReceipt
    
    str_Recipient = [I]insert address here[/I]
    
    EmailSend.Recipients.Add (str_Recipient)
    EmailSend.Save
    EmailSend.Display

 

[froggiebeckie]

Thanks for the code

Thanks for the code. I've worked with it as much as I could today (time constraints) and I can't figure out what to do with it.

Hate to sound stupid, but should I use your code in addition to or instead of the code I've been working with?

Thanks again,
BeckieO

 

[froggiebeckie]

Thanks again--figured it out and it's working great.

Again, thanks for helping me look good.

BeckieO