Adding Attachments VBA

I am wanting to add attachments to an Outlook email and it is working but the last attachment is being added twice.  I only want to add the attachment once.  Can someone show me where I am going wrong?  

Thanks


1.  I start by clicking a button which triggers the following:

Private Sub StatusReport_Click()

If MsgBox("Do you want to email a status report to the team?", vbYesNo) = vbYes Then

DoCmd.OutputTo acOutputReport, "Report Name 1", acFormatPDF, File Path, False
DoCmd.OutputTo acOutputReport, "Report Name 2", acFormatPDF, File Path, False

Call SendMessage(False, "Report Name 1;Report Name 2")

MsgBox "Email Sent."

End If

2.  This is the code it calls

     Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
          Dim objOutlook As Outlook.Application
          Dim objOutlookMsg As Outlook.MailItem
          Dim objOutlookRecip As Outlook.Recipient
          Dim objOutlookAttach As Outlook.Attachment
          Dim TempArray() As String
          Dim varArrayItem As Variant



          ' 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("email@gmail.com")
              objOutlookRecip.Type = olTo

              ' Add the CC recipient(s) to the message.
''                Set objOutlookRecip = .Recipients.Add("email2@gmailcom")
''                objOutlookRecip.Type = olCC
''                Set objOutlookRecip = .Recipients.Add("3mail3@gmail.com")
''                 objOutlookRecip.Type = olCC

'             ' Add the BCC recipient(s) to the message.
'              Set objOutlookRecip = .Recipients.Add("x")
'              objOutlookRecip.Type = olBCC

             ' Set the Subject, Body, and Importance of the message.
             .Subject = "TEST EMAIL"
             .Body = "See attached files for a list of missing or pending information." & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "This email was automatically generated.  See system administrator for more details." & vbCrLf & vbCrLf
             .Importance = olImportanceHigh 'High importance

             ' Add attachments to the message.
             If Not IsMissing(AttachmentPath) Then
                TempArray = Split(AttachmentPath, ";")
               
                For Each varArrayItem In TempArray
                        AttachmentPath = Trim(TempArray)
                   
                    If Len(AttachmentPath) > 0 Then
                        .Attachments.Add AttachmentPath
                    End If
               
                Next varArrayItem

             Set objOutlookAttach = .Attachments.Add(AttachmentPath)

             End If

             ' Resolve each Recipient's name.
             For Each objOutlookRecip In .Recipients
                objOutlookRecip.Resolve
             Next

             ' Should we display the message before sending?
             If DisplayMsg Then
                 .Display
             Else
                 .Save
                 .Send
             End If
          End With
          Set objOutlook = Nothing
      End Sub


As I metioned Report Name in the email is attached twice.  It should only be added once.  I would like this to be automated so I am stuck until this is fixed.  Any assistance in this would be appreciated.

Thanks, Experts!

mtrussellAsked:
Who is Participating?
 
JezWaltersCommented:
Chris hasn't spotted the repeated .Attachments.Add statement.  The following code gives you what you want:

Public Sub SendMessage(DisplayMsg As Boolean, _
                       Optional AttachmentPath)

    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim TempArray() As String
    Dim varArrayItem As Variant

    ' 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("email@gmail.com")
        objOutlookRecip.Type = olTo

        ' Add the CC recipient(s) to the message.
'        Set objOutlookRecip = .Recipients.Add("email2@gmailcom")
'        objOutlookRecip.Type = olCC
'        Set objOutlookRecip = .Recipients.Add("3mail3@gmail.com")
'        objOutlookRecip.Type = olCC

'       ' Add the BCC recipient(s) to the message.
'        Set objOutlookRecip = .Recipients.Add("x")
'         objOutlookRecip.Type = olBCC

        ' Set the Subject, Body, and Importance of the message.
        .Subject = "TEST EMAIL"
        .Body = "See attached files for a list of missing or pending information." & vbCrLf & vbCrLf & vbCrLf & _
                "This email was automatically generated.  See system administrator for more details." & vbCrLf & vbCrLf
        .Importance = olImportanceHigh  ' High importance

        ' Add attachments to the message.
        If Not IsMissing(AttachmentPath) Then
            TempArray = Split(AttachmentPath, ";")

            For Each varArrayItem In TempArray
                AttachmentPath = Trim(varArrayItem)

                If Len(AttachmentPath) > 0 Then
                    .Attachments.Add AttachmentPath
                End If
            Next

        End If

        ' Resolve each Recipient's name.
        For Each objOutlookRecip In .Recipients
            objOutlookRecip.Resolve
        Next

        ' Should we display the message before sending?
        If DisplayMsg Then
            .Display
        Else
            .Save
            .Send
        End If
    End With
    Set objOutlook = Nothing

End Sub

Open in new window

0
 
JezWaltersCommented:
You're getting too many attachments because you've got two ".Attachments.Add" statements.
Remove the second one and you should be fine.
0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
Are you saying you pass two filepaths and the first one is attached twice?

Chris
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
JezWaltersCommented:
You've got a coding error too; the statement:
AttachmentPath = Trim(TempArray)

should be:
AttachmentPath = Trim(varArrayItem)
0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
Aha!, Try replacing the block:
                For Each varArrayItem In TempArray
                        AttachmentPath = Trim(TempArray)
                   
                    If Len(AttachmentPath) > 0 Then
                        .Attachments.Add AttachmentPath
                    End If
               
                Next varArrayItem

with
                For Each varArrayItem In TempArray
                        AttachmentPath = Trim(varArrayItem )
                   
                    If Len(AttachmentPath) > 0 Then
                        .Attachments.Add AttachmentPath
                    End If
               
                Next varArrayItem

BAsically you aren't using the array parameters rather the array itself

Chris
0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
Chris has but you had already made that post ... the other re the array error we posted in parallel so I wasn't restating it which would have been the case had I referenced the duplication, (of the last attachment)

Chris
0
 
JezWaltersCommented:
That happens quite a lot - no offense intended!  :-)
0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
None taken ... the fact is I took a little longer to detail the post hence I was slower BUT I never saw the duplicate entry till you mentioned it.  All part of life's rich tapestry, sometimes I miss out on a post because I give insufficient detail and others I miss out because adding the detail took too long.  Ho hum.

Chris
0
 
JezWaltersCommented:
As you say, it all comes with the territory of being an Expert ... and then the wrong answer gets accepted!  ;-)
0
 
mtrussellAuthor Commented:
Jez and Chris - I really appreciate your help on this... works like a charm.  I guess double dipping would cause it to post twice... ;)

Jez if it is ok I gave Chris a bit of the points just cause his heart and skills were in the right place.  

Without you guys, I'd had a long day...
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.