Solved Multiple Attachments on single email from listbox (1 Viewer)

[allen675]

Hello,

I am sure this has been discussed somewhere on this forum already, however, I cant find it! Been experimenting with some code. So far the code picks up the attachments from the list box but puts each one into a separate email. I want all attachments in listbox to be attached to the same email. Here's what I have:

Private Sub Command2_Click()
Dim subject As String, Body As String
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

  On Error Resume Next
  Set OutApp = GetObject(, "Outlook.Application")
  If OutApp Is Nothing Then
    Set OutApp = CreateObject("Outlook.Application")
  End If
  On Error GoTo 0

  For intCurrentRow = 0 To ProofList.ListCount - 1
     Set OutMail = OutApp.CreateItem(olMailItem)

     With OutMail
         ProofList.Selected(intCurrentRow) = True

        .To = vbNullString
        .subject = "Test Email"
        .Body = vbNullString
        .Attachments.Add Application.CurrentProject.Path & "\ContactProofs\" & ProofList.Column(2)
        .Display
        
     End With
  Next intCurrentRow

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[CJ_London]

you are creating a new email on each loop - try this

Private Sub Command2_Click()
Dim subject As String, Body As String
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

  On Error Resume Next
  Set OutApp = GetObject(, "Outlook.Application")
  If OutApp Is Nothing Then
    Set OutApp = CreateObject("Outlook.Application")
  End If
  On Error GoTo 0

  
     Set OutMail = OutApp.CreateItem(olMailItem)

     With OutMail
         ProofList.Selected(intCurrentRow) = True

        .To = vbNullString
        .subject = "Test Email"
        .Body = vbNullString
         For intCurrentRow = 0 To ProofList.ListCount - 1
             .Attachments.Add Application.CurrentProject.Path & "\ContactProofs\" & ProofList.Column(2)
        Next intCurrentRow
        .Display
        
     End With
  

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[MarkK]

I think it is always worthwhile to break code up into units of work, like...

Private Property Get ProofPath() As String
    ProofPath = CurrentProject.Path & "\ContactProofs\"
End Property

Private Property Get OutlookApp() As Outlook.Application
On Error Resume Next
    Dim app As Object
    
    Set app = GetObject(, "Outlook.Application")
    If app Is Nothing Then Set app = CreateObject("Outlook.Application")
    Set OutlookApp = app
End Property

Private Function NewMailItem(ToField As String, Subject As String, Body As String) As Outlook.MailItem
    Dim tmp As Outlook.MailItem
    
    Set tmp = OutlookApp.CreateItem(olMailItem)
    With tmp
        .to = ToField
        .Subject = Subject
        .Body = Body
    End With
    Set NewMailItem = tmp
End Function

Private Sub CreateAndDisplayEmail()
    Dim var
    
    With NewMailItem("", "Test Email", "")
        For Each var In ProofList.ItemsSelected
            .Attachments.Add ProofPath & ProofList.Column(2, var)
        Next
        .display
    End With
End Sub

Private Sub Command2_Click()
    CreateAndDisplayEmail
End Sub

One advantage here being that the OutlookApp property, and the NewMailItem function become available for reuse by other code.

 

[allen675]

you are creating a new email on each loop - try this

Private Sub Command2_Click()
Dim subject As String, Body As String
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

  On Error Resume Next
  Set OutApp = GetObject(, "Outlook.Application")
  If OutApp Is Nothing Then
    Set OutApp = CreateObject("Outlook.Application")
  End If
  On Error GoTo 0

 
     Set OutMail = OutApp.CreateItem(olMailItem)

     With OutMail
         ProofList.Selected(intCurrentRow) = True

        .To = vbNullString
        .subject = "Test Email"
        .Body = vbNullString
         For intCurrentRow = 0 To ProofList.ListCount - 1
             .Attachments.Add Application.CurrentProject.Path & "\ContactProofs\" & ProofList.Column(2)
        Next intCurrentRow
        .Display
       
     End With
 

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Hi @CJ_London thank you for this code. When I've tried it it opens a new Outlook mail item and adds the same attachment twice!?

 

[allen675]

I think it is always worthwhile to break code up into units of work, like...

Private Property Get ProofPath() As String
    ProofPath = CurrentProject.Path & "\ContactProofs\"
End Property

Private Property Get OutlookApp() As Outlook.Application
On Error Resume Next
    Dim app As Object
   
    Set app = GetObject(, "Outlook.Application")
    If app Is Nothing Then Set app = CreateObject("Outlook.Application")
    Set OutlookApp = app
End Property

Private Function NewMailItem(ToField As String, Subject As String, Body As String) As Outlook.MailItem
    Dim tmp As Outlook.MailItem
   
    Set tmp = OutlookApp.CreateItem(olMailItem)
    With tmp
        .to = ToField
        .Subject = Subject
        .Body = Body
    End With
    Set NewMailItem = tmp
End Function

Private Sub CreateAndDisplayEmail()
    Dim var
   
    With NewMailItem("", "Test Email", "")
        For Each var In ProofList.ItemsSelected
            .Attachments.Add ProofPath & ProofList.Column(2, var)
        Next
        .display
    End With
End Sub

Private Sub Command2_Click()
    CreateAndDisplayEmail
End Sub

One advantage here being that the OutlookApp property, and the NewMailItem function become available for reuse by other code.

Hi @MarkK, thank you for the code. Your code does not attach anything unless you select the item first. I'm only using the list box as a method to display what is being attached. I'm looking for code that will loop through each item in said list box, without, end user interacting with said listbox, and attach items to a single email

 

[MarkK]

My code is intended to illustrate the advantages of breaking up longer procedures into smaller units of work. Feel free to modify it to your exact purpose.

 

[allen675]

Okay thanks @MarkK. This is not my issue, I have tried and failed at what I was attempting hence why I am here asking for help.

 

[Gasman]

Probably need to use the itemdata property?

cycling through values in a MS Access list box

I have a list box that populates with different sets of data based on user selections. How can I cycle through any given values that may be in the list box? Is this a For Each statement, or what?

stackoverflow.com

 

[allen675]

Probably need to use the itemdata property?

cycling through values in a MS Access list box

I have a list box that populates with different sets of data based on user selections. How can I cycle through any given values that may be in the list box? Is this a For Each statement, or what?

stackoverflow.com

@Gasman how would I incorporate that into the code please?

 

[Gasman]

Look at that link I posted. Use in conjunction with CJ_London's code logic.
Effectively you want the itemdata per row.

 

[allen675]

Could you not just show me how I fit that in with the code please?

 

[Gasman]

No, as I am on my phone.
See this link https://docs.microsoft.com/en-us/office/vba/api/access.listbox.itemdata

Another link more relevant?

ListBox.ItemData property (Access)

Office VBA reference topic

docs.microsoft.com

Edit: If you use the column property instead as shown by MarkK

ListBox.Column property (Access)

Office VBA reference topic

docs.microsoft.com

Really depends on whether that data column is bound or not.

 

[allen675]

@Gasman once again I find myself staring at the screen without a clue what to do, scratching my head, really confused. Please don't take this the wrong way but you have now been involved in three maybe four of my threads, and every time I find your input really frustrating! I get your slogan 'Give a man a fish and you feed him for a day. Teach a man to fish and you feed him for a lifetime'. Live by your slogan man and teach me/us, rather than throwing us the fish. I am not a VBA programmer so as I have said to you before simply pointing me to a link, expecting me to read and then understand it does not work. Once I have working code in front of me then it starts to make sense.

Does anyone else have any more ideas please? I thought I was there with my code and was expecting this to be a really simple fix but evidently not!

Thanks in advance

 

[Gasman]

Not a problem. I will step back.

 

[allen675]

@arnelgp are you able to help please? I note that you helped in this thread: (2) Solved - Sending Email to recipients from Listbox | Access World Forums (access-programmers.co.uk) where @Momma wanted to loop through a listbox.

Thanks in advance

 

[CJ_London]

adds the same attachment twice!?

I just used the same code you said worked - check what you had when you were getting two emails - are they the same attachment?

 

[allen675]

So my original code opens two emails one with each of the attachments.

Your amended code adds the same attachment twice to one email

 

[CJ_London]

So my original code opens two emails one with each of the attachments

if that is the case then you should get two different attachments. All I did was move the loop - please post the code you actually used

I wondered about your use of

& ProofList.Column(2)

as normally you would loop through itemdata as indicated by Gasman - but you say it works so I wasn't going to change things unnecessarily.

 

[allen675]

Unfortunately not! :-(

Literally copied and pasted the code you provided, I can repost if you would like me to?

This is what I couldn't work out, I thought I was really close with the code I had!

 

[CJ_London]

got it. you need to move

ProofList.Selected(intCurrentRow) = True

to back within the loop

For intCurrentRow = 0 To ProofList.ListCount - 1
     ProofList.Selected(intCurrentRow) = True

     .Attachments.Add Application.CurrentProject.Path & "\ContactProofs\" & ProofList.Column(2)
  Next intCurrentRow