Outlook.Application with attachments

[Gand114]

Hi to everyone!
My little project with ratesheets (for those who helped already thanks alot again) is going on and now I am at the point where i need to send the files created as attachment.
Basically, I have access create a series of pdf files that are ratesheets (reports)
They get all saved with a precise name, say "customer xxx ratesheet june 2016" in a selected folder.
I have a table with on columnA the name of the customer (same as the one in the pdf files) and column B the email address.

Now what i want is access to pick the file for customer xxx and send it to it's email address
then take the file for customer yyy and send to its email address.
zzz, qqq and so on.

What I wrote so far is the following (i know it sucks but I am doing my best with my little knowledge)

Private Sub Comando2_Click()

'send files as attachment


Dim cnn1 As ADODB.Connection
Set cnn1 = CurrentProject.Connection
Dim rs As New ADODB.Recordset
rs.activeconnection = cnn1
rs.Open "[soloragsoc]" 'this recordset have on colA the name of the customers and on colB the email address


Dim pafi As String
Dim file As String
Dim path As String
Dim db As Database
Dim ingragsoc As String
ingrasoc = rs.Fields(0) 'this field has customer names identical to the one in the pdf file

 Dim oOutlook As Outlook.Application
 Dim oEmailItem As MailItem
 
path = "C:\Users\diego.macaluso\Desktop\EXEPE"
file = "\Listino Tetris Consolidation export Giugno 2016" & " " & ingragsoc & ".pdf"
Dim fulpafi As String
fulpafi = path & file
Dim roccodio As String

Dim filnoex As String
Dim strposta As String


If Not rs.EOF Then
rs.MoveFirst
Do While Not rs.EOF And True
strposta = rs.Fields(1) 'this have the email address


   Set oOutlook = GetObject(, "Outlook.Application")
   If oOutlook Is Nothing Then Set oOutlook = CreateObject("Outlook.Application")

  Set oEmailItem = oOutlook.createitem(olmailitem)

  With oEmailItem
     .Attachments.Add fulpafi
    
     
     .To = strposta
    
     .Subject = "Listino Export"
     .Body = "Buongiorno, in allegato trovate nostro listino aggiornato, comprensivo dei prezzi per le destinazioni in Africa. Cordiali saluti"


    .Display
   End With
Loop
End If


rs.Close
Set oEmailItem = Nothing
   Set oOutlook = Nothing
Set rs = Nothing
Set db = Nothing

   
 End Sub

1st issue: for some reason

  With oEmailItem
     .Attachments.Add fulpafi

doesn't find the file (whatever, I tried with a constant "xxx.pdf" and that works, if you have any idea on this is more than welcome)

The second issue and this is the one i can't really figure out myself is that the code, as it is, creates as many email as there are customers in the recordset but all to the first email address (and allegedly all with the same attachments but can't tell for sure)

All in all I am as far as i could be from getting it working as I expected, can anyone help me?

Thanks, ciao!

 

[Ranman256]

 Private Sub Comando2_Click()
 'send files as attachment
Dim pafi As String
Dim file As String
Dim path As String
Dim ingragsoc As String
Dim oOutlook As Outlook.Application
Dim oEmailItem As MailItem
Dim fulpafi As String
Dim roccodio As String
Dim filnoex As String
Dim strposta As String
 
   'start outlook just once
Set oOutlook = GetObject(, "Outlook.Application")
'or
'Set oOutlook = CreateObject("outlook.application")
 
    '(file names do not have slashes)
path = "C:\Users\diego.macaluso\Desktop\EXEPE\"
Set rs = CurrentDb.OpenRecordset("myquery")
With rst
    While Not .EOF
        ingrasoc = rs.Fields(0)   'this field has customer names identical to the one in the pdf file
        strposta = rs.Fields(1)   'this have the email address
    
        file = "Listino Tetris Consolidation export Giugno 2016" & " " & ingragsoc & ".pdf"
        fulpafi = path & file
    
       'If oOutlook Is Nothing Then Set oOutlook = CreateObject("Outlook.Application")
          Set oEmailItem = oOutlook.createitem(olmailitem)
          With oEmailItem
             .Attachments.Add fulpafi
            
             .To = strposta
             .Subject = "Listino Export"
             .Body = "Buongiorno, in allegato trovate nostro listino aggiornato, comprensivo dei prezzi per le destinazioni in Africa. Cordiali saluti"
        
            .Display
           End With
       
       .MoveNext   'next record
    Wend
End With
 rs.Close
Set oEmailItem = Nothing
Set oOutlook = Nothing
Set rs = Nothing
Set db = Nothing
End Sub

 

[Gand114]

WOW Ranman, thank you so much!
I am trying to understand how this works, but thanks truly a lot. It would have taken literally days for me to figure it out all by myself, and instead it works like a charm.
Now I am trying to tell it that if the email field is empty it shall just skip it.
I'll try not to bother, hopefully I ll manage

Thanks again!