Consulting

Results 1 to 5 of 5

Thread: VBA MailItem in Loop for multiple emails

  1. #1
    VBAX Newbie
    Joined
    Dec 2017
    Posts
    3
    Location

    VBA MailItem in Loop for multiple emails

    I'm trying to send an email for each record in a recordset with the selected Query.
    The code creates a recordset to show me how many suppliers I have in my inquiry. Next I build an SQL string sSQL for each supplier ("Lieferant"). This should be an Attachement as XLS. After that I use a Loop to create a temporary query which I have to send to each supplier. Here is my code:


    Sub ExcelExportuSenden()
        Dim db As DAO.Database
        Dim rs As DAO.Recordset
        Dim qd As DAO.QueryDef
        Dim sSQL As String
        Dim oApp As Outlook.Application
        Dim oMail As MailItem
        Dim fileName As String
    
    
        Set db = CurrentDb
        Set qd = db.CreateQueryDef("Lieferant", "SELECT * FROM [Filter_Ausschreibung_original]  WHERE 1 = 0")
        Set qd = Nothing
        Set rs = db.OpenRecordset( _
        "SELECT DISTINCT [Lieferant] FROM [Filter_Ausschreibung_original] ", _
        dbOpenForwardOnly)
        Set oApp = CreateObject("Outlook.Application")
        Set oMail = oApp.CreateItem(olMailItem)
    
        With rs
            Do While Not .EOF
                sSQL = "SELECT * FROM [Filter_Ausschreibung_original] " & _
                " WHERE Lieferant = '" & .Fields("Lieferant") & "'"
                db.QueryDefs("Anfrage").SQL = sSQL
                Debug.Print sSQL    
                .MoveNext
            Loop
            .Close
        End With
        With oMail
            .Subject = ""
            .Body = "Sehr geehrte Damen und Herren," & vbCr & "" & vbCr & "anbei erhalten Sie" & _
            vbCr & "" & vbCr & "- die Auftragsbestätigung für die erbrachte Dienstleistung vor Ort" & _
            vbCr & "- die Prüfbescheinigungen für die wiederkehrende Prüfung vor Ort" & _
            vbCr & "- die aktuelle Übersicht der Schlauchleitungen." & _
            vbCr & "" & vbCr & "Die Rechnung senden wir separat an die angegebene Rechnungsadresse." & _
            vbCr & "" & vbCr & "Für eventuelle Rückfragen stehen wir Ihnen zur Verfügung, gerne auch persönlich nach Terminvereinbarung." & _
            vbCr & "" & vbCr & "Mit freundlichen Grüßen" & _
            vbCr & "" & vbCr & ""
            .Display
        End With
        db.QueryDefs.Delete "Lieferant"
        Set rs = Nothing
        Set db = Nothing
    End Sub
    I'm trying to send an email for each record in a recordset with the selected Query.
    The code creates a recordset to show me how many suppliers I have in my inquiry. Next I build an SQL string sSQL for each supplier ("Lieferant"). This should be an Attachement as XLS. After that I use a Loop to create a temporary query which I have to send to each supplier. Here is my code:
    Sub ExcelExportuSenden()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim qd As DAO.QueryDef
    Dim sSQL As String
    Dim oApp As Outlook.Application
    Dim oMail As MailItem
    Dim fileName As String


    Set db = CurrentDb
    Set qd = db.CreateQueryDef("Lieferant", "SELECT * FROM [Filter_Ausschreibung_original] WHERE 1 = 0")
    Set qd = Nothing
    Set rs = db.OpenRecordset( _
    "SELECT DISTINCT [Lieferant] FROM [Filter_Ausschreibung_original] ", _
    dbOpenForwardOnly)
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(olMailItem)

    With rs
    Do While Not .EOF
    sSQL = "SELECT * FROM [Filter_Ausschreibung_original] " & _
    " WHERE Lieferant = '" & .Fields("Lieferant") & "'"
    db.QueryDefs("Anfrage").SQL = sSQL
    Debug.Print sSQL
    .MoveNext
    Loop
    .Close
    End With
    With oMail
    .Subject = ""
    .Body = "Sehr geehrte Damen und Herren," & vbCr & "" & vbCr & "anbei erhalten Sie" & _
    vbCr & "" & vbCr & "- die Auftragsbestätigung für die erbrachte Dienstleistung vor Ort" & _
    vbCr & "- die Prüfbescheinigungen für die wiederkehrende Prüfung vor Ort" & _
    vbCr & "- die aktuelle Übersicht der Schlauchleitungen." & _
    vbCr & "" & vbCr & "Die Rechnung senden wir separat an die angegebene Rechnungsadresse." & _
    vbCr & "" & vbCr & "Für eventuelle Rückfragen stehen wir Ihnen zur Verfügung, gerne auch persönlich nach Terminvereinbarung." & _
    vbCr & "" & vbCr & "Mit freundlichen Grüßen" & _
    vbCr & "" & vbCr & ""
    .Display
    End With
    db.QueryDefs.Delete "Lieferant"
    Set rs = Nothing
    Set db = Nothing
    End

    The current code does not create an email for each "Lieferant. It only starts with an email (with the first "Lieferant"), and after sending the email it doesn't open the next mail. So, i guess something is wrong with the Event "with rs" and "with oMail". I guess I should use "for each rs". Am I right?

  2. #2
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Your emailing VBA is NOT inside the Loop going through the rs recordset Records.

  3. #3
    VBAX Newbie
    Joined
    Dec 2017
    Posts
    3
    Location
    May you can help, how it is correct inside the loop? I tried different ways, but it doesn't works.

  4. #4
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    Sub ExcelExportuSenden()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim qd As DAO.QueryDef
    Dim sSQL As String
    Dim oApp As Outlook.Application
    Dim oMail As MailItem
    Dim fileName As String


    Set db = CurrentDb
    Set qd = db.CreateQueryDef("Lieferant", "SELECT * FROM [Filter_Ausschreibung_original] WHERE 1 = 0")
    Set qd = Nothing
    Set rs = db.OpenRecordset( _
    "SELECT DISTINCT [Lieferant] FROM [Filter_Ausschreibung_original] ", _
    dbOpenForwardOnly)
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(olMailItem)

    With rs
    Do While Not .EOF
    sSQL = "SELECT * FROM [Filter_Ausschreibung_original] " & _
    " WHERE Lieferant = '" & .Fields("Lieferant") & "'"
    db.QueryDefs("Anfrage").SQL = sSQL
    Debug.Print sSQL
    .MoveNext
    With oMail
    .Subject = ""
    .Body = "Sehr geehrte Damen und Herren," & vbCr & "" & vbCr & "anbei erhalten Sie" & _
    vbCr & "" & vbCr & "- die Auftragsbestätigung für die erbrachte Dienstleistung vor Ort" & _
    vbCr & "- die Prüfbescheinigungen für die wiederkehrende Prüfung vor Ort" & _
    vbCr & "- die aktuelle Übersicht der Schlauchleitungen." & _
    vbCr & "" & vbCr & "Die Rechnung senden wir separat an die angegebene Rechnungsadresse." & _
    vbCr & "" & vbCr & "Für eventuelle Rückfragen stehen wir Ihnen zur Verfügung, gerne auch persönlich nach Terminvereinbarung." & _
    vbCr & "" & vbCr & "Mit freundlichen Grüßen" & _
    vbCr & "" & vbCr & ""
    .Display
    End With
    Loop
    .Close
    End With

    db.QueryDefs.Delete "Lieferant"
    Set rs = Nothing
    Set db = Nothing
    End Sub


    The other thing to check is how many records your loop is actually processing, I personally do not like do until rs.EOF
    So add 3 lines of code after this line
    Set rs = db.OpenRecordset( _
    "SELECT DISTINCT [Lieferant] FROM [Filter_Ausschreibung_original] ", _
    dbOpenForwardOnly)

    rs.movelast
    rs.movefirst
    msgbox rs.recordcount

    The last line will tell you how many records are in the recordset.
    The other point is what it the Query sSQL doing, you do not actually creat a dataset for it or try to pass any values to the email either?

  5. #5
    VBAX Newbie
    Joined
    Dec 2017
    Posts
    3
    Location
    OK I will try it tomorrow in my office...thanks for your help!
    My query sSQL should be my attachement for wach RS. But therefore I know how it works. ;-)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •