email with outlook.application

[JJCHCK]

hi everybody
i have a button to send email to different peoples with their own information


the button is "libreria outlook"

sorry for my english

i attach my mdb

[NoellaG]

Hi,

ad what is your question?

gr
NG

[JJCHCK]

if you click "libreria outlook" the mail stop at the first record (daveweckel)
so the loop stops
What wrong on my code?

[JJCHCK]

eureka
the code " Set outMsg = outApp.CreateItem(olMailItem)"
must be set after "Do until rs.eof

[NoellaG]

Hi,

indeed your code needed a bit shuffling around. I also added some code to check if the recordset isn't empty and an exit point so you don't get into the error code even with no error:

 Private Sub Comando32_Click()
     On Error GoTo err:
 
 Dim rs As DAO.Recordset
 Dim VDb As DAO.Database
 Dim VEmail, VAgente As Variant
  
 Set VDb = CurrentDb
 Set rs = VDb.OpenRecordset("SELECT * FROM ResiEmail")

 DoCmd.OutputTo acReport, "ResiEmail", acFormatPDF, "C:\Documents and Settings\junior\Desktop\Rpt_Resi\ResiEmail.pdf"
' DoEvents
 
 Dim outApp As OUTLOOK.Application, outMsg As MailItem
 
 Set outApp = CreateObject("Outlook.Application")
 Set outMsg = outApp.CreateItem(olMailItem)

 'VAgente = rs.Fields("agente")
    'VPAgente = VAgente
 If Not (rs.BOF And rs.EOF) Then 'take care of the possibility that the recordset is empty
     rs.MoveFirst
     Do While Not rs.EOF
        If VAgente = rs.Fields("agente") Then
            'rs.MoveNext
        Else
            VAgente = rs.Fields("agente")
            VPAgente = VAgente
            VEmail = rs.Fields("email")
            With outMsg
               .Importance = olImportanceHigh
               '.SendUsingAccount = outApp.Session.Accounts.Item(2)
               .ReadReceiptRequested = True ' conferma lettura
               .OriginatorDeliveryReportRequested = True ' conferma recapito
               .To = VEmail
               .CC = "jjjjjjj@tiscali.it"
               .BCC = "jjjjjjj@tiscali.it"
               .Subject = "oggetto"
               .Body = "messaggio"
               .Attachments.Add ("C:\Documents and Settings\junior\Desktop\Rpt_Resi\ResiEmail.pdf")
               .Display
               '.Send
            End With
    
            Debug.Print (VEmail)
       End If
             
        rs.MoveNext
    Loop
End If

   
   Set outApp = Nothing
   Set outMsg = Nothing
exit_Commando:
    Exit Sub
    
err:
    MsgBox (err.Description & err.Number)
    err.Clear
End Sub

gr
NG

[JJCHCK]

thanks a lot
you have reply so quickly