mail versturen met attachment

[HankMegens]

Hoi,

Ik heb veel zitten zoeken om VBA te vinden om een emails met attachment te versturen.
Ik verstuur hem op basis van een query die het personeel en de diensten tabellen combineerd.
Echter mijn code verstuurd nu niet 18 mails (naar elke werknemer zijn planning) maar ongeveer 172 mails (alle records uit de query.
Het probleem zit hem in een stukje code in de module email, nl:


strSQL = "SELECT * from Qplanningperpersoon"
Set rspersoneel = CurrentDb.OpenRecordset(strSQL)

Hoe pas ik strSQl aan om het tot een mail per werknemer terug te brengen.
De database heb ik toegevoegd

 

[OctaFish]

Zal er morgen naar kijken! De oplossing is denk ik dat je met een loop de records opent, dus je Select uitbreiden met een WHERE op basis van PersoneelID. Dan maak je dus per werknemer​ een mail aan.

 

[xps351]

Vervang de regel

strSQL = "SELECT * from Qplanningperpersoon"

door

strSQL = "SELECT distinct PersoneelID, Achternaam, Voornaam, Email from Qplanningperpersoon"

in de "functie" verstuurplanning

Je hoeft Qplanningperpersoon overigens niet te groeperen. Er staan geen sommeringen en dergelijke in. Met of zonder, er komen 172 rijen uit.

 

[OctaFish]

Ik kom tot dit:

Public Function verstuurplanning()
Dim rst As DAO.Recordset
Dim strSQL As String, strReportName As String, strFileName As String
Dim objOutlook As Object, objMail As Object
Dim tel As Integer


    strSQL = "SELECT DISTINCT personeelID, Voornaam, tussenvoegsel, Achternaam, Email From Qplanningperpersoon "
    Set rst = CurrentDb.OpenRecordset(strSQL)
    Debug.Print rst.RecordCount
    strReportName = "rdienstenperpersoon"
    Set objOutlook = CreateObject("Outlook.Application")
    
    Do While Not rst.EOF
        strFileName = CurrentProject.Path & "\" & rst("personeelID") & rst("Achternaam") & rst("Voornaam") & ".pdf"
        SaveAsPDF strReportName, strFileName, rst("personeelID")
        Set objMail = objOutlook.CreateItem(olMailItem)
        With objMail
            .To = rst("Email")
            .Subject = "Hoi" & rst("Voornaam") & "Hierbij de planning volgende week"
            .Body = "Hierbij de planning voor komende week"
            .Attachments.Add strFileName
            .Display
            ''.Send
        End With
        rst.MoveNext
    Loop
    
End Function

Met Group By is natuurlijk niet fout, dan krijg je dit:

    strSQL = "SELECT DISTpersoneelID, Voornaam, tussenvoegsel, Achternaam, Email From Qplanningperpersoon " _
        & "GROUP BY personeelID, Voornaam, tussenvoegsel, Achternaam, Email"

Werkt net zo goed als een Distinct.

 

[HankMegens]

Heren,

Bedankt voor het meedenken en helpen.
De voorgestelde code, vertuurt alleen de planning van werkenemer met personeelID =1, ongeacht welk record ik in mijn formulier personeel open heb staan. (daar heb ik tijdelijk de komt voor het mailen aan alleen gezet.)
Debug.Print rst.RecordCount geeft ook maar 1 aan.
Waarom loopt hij niet door alle records?

HAnk

 

[xps351]

De voorgestelde code, vertuurt alleen de planning van werkenemer met personeelID =1, ongeacht welk record ik in mijn formulier personeel open heb staan.

Welke code bedoel je? Er zijn twee oplossingen voorbijgekomen.

De aanpassing die ik voorstelde werkt in ieder geval in de database die je meestuurde. Dat heb ik getest.
Wat de relevantie is van je opmerking over het record dat openstaat is me niet duidelijk. Je wilt immers naar meerdere personen iets mailen.

 

[HankMegens]

Peter,

Dat over het openstaande record op het formulier gaf ik mee, mocht dit misschien invloed hebben op de werking van de functie.
Bij mij loopt hij niet door de records heen, Hij stuurt voor personeelID=1 wel een mailtje voor twee diensten. Dat werkt dus wel.

Het betreft de code van Octafish

 

[HankMegens]

Ik had in mijn database zitten werken.
Heb nu mijn oude versie terug gepakt en nu werkt het.


Hank

 

[OctaFish]

Dan zou die inderdaad moeten lopen, want bij mij werkt het dus prima. Maar bij jou nu ook, zie ik. :thumb: