ACCES VBA "naar meerdere adressen mailen" : nieuw vraagje @OctaFish

Status
Niet open voor verdere reacties.
F

fde

Gebruiker
Lid geworden
31 aug 2017
Berichten
110
Beste OctaFish,

Ik refereer hiermee naar een eerder draadje van 17/08/2011 t.e.m. 19/08/2011 met de benaming "naar meerde adressen mailen".

Deze oplossing heb ik toegepast voor een dagelijkse verjaardag mailing ; en deze werkt perfect na enkele aanpassingen uiteraard.

Nu wou ik deze toepassen op een zoek formulier en vandaaruit de mailing opstarten ; maar daar loopt het fout.

Het betreft de form: "frm-sollicitant_zoek_functie" : deze komt uit de tbl_sollicitant en/of qry_sollicitant (deze zijn identiek)

In één van jou VBA-Access lessen heb ik gevonden/geleerd hoe je een filter via een keuzelijst met invoervak kunt weergeven op een form (VBA-code). Dit werkt perfect, ook in mijn form !!!
Deze filter gebruik ik om een functie te zoeken van een bepaalde sollicitant en weer te geven op de form: frm-sollicitant_zoek_functie. Dit desbetreffende formulier = een doorlopend formulier.

Als je nou kijkt naar de tbl_sollicitant of qry_sollicitant daar zit +- 5.800 records in en het is niet de bedoeling dat ik iedereen telkens aanschrijf ; dat kan de bedoeling niet zijn.
Ik kan wel een selectie volgens maken op het formulier (frm-sollicitant_zoek_functie) en daar de juiste gegeven uit tevoorschijn krijgen, maar deze gegroepeerd doormailen lukt me niet.

In het doorlopend formulier (frm-sollicitant_zoek_functie) staan volgende gegevens ; NAAM - VOORNAAM - GEBOORTEDATUM - LEEFTIJD - EMAIL - GSM/TELEFOON - SELECTIEVAKJE.

Momenteel gebruik ik volgende VBA code:

Code: 
Private Sub btnTestMailing_Click()
Dim appOutLook As Outlook.Application
    Dim MailOutLook As Outlook.MailItem
    Dim sEmail As String
    Dim sVerzonden As String
    Dim iAantal As Integer
    Dim i As Integer
    
    Set appOutLook = CreateObject("Outlook.Application")
    'Set MailOutLook = appOutLook.CreateItem(olMailItem)
    Set MailOutLook = appOutLook.CreateItemFromTemplate("c:\tmp\jobopportuniteit.oft")
            
    sEmail = ""
    sVerzonden = ""
    
        With CurrentDb.OpenRecordset("qry_sollicitant")
    '   With CurrentDb.OpenRecordset("qry_sollicitant WHERE chkSelecteer = TRUE")
    '   With CurrentDb.OpenRecordset("qry_sollicitant WHERE SELECTEER_SOLLICITANT = TRUE")
        If Not .RecordCount = 0 Then
            .MoveLast
            .MoveFirst
            iAantal = .RecordCount
            Do While Not .EOF
                sEmail = sEmail & .Fields("EMAIL_SOLLICITANT").Value
                    If i < iAantal Then sEmail = sEmail & ";"
                   ' i = i + 1
            With MailOutLook
                '.Body = "" ' == Bij set MailoutLook ; createFromTemplate ; GEEN .Body gebruiken ==
                '.To = sEmail
                .BCC = sEmail
                .Subject = "TDDE - "
                .Display
             End With
                sVerzonden = sVerzonden & sEmail & ", "
                .MoveNext
            Loop
        End If
    End With
    
    Do While Right(sVerzonden, 2) = ", "
    sVerzonden = Left(sVerzonden, Len(sVerzonden) - 2)
    Loop
    Msgbox "Er is een mail gestuurd naar " & sEmail & "."
    Exit Sub

email_error:
Msgbox "Er was een foutje..." & vbCrLf & "En wel: " & Err.Description

End Sub

Ik heb mijn probeersels ook laten staan zodat je kan zien wat ik "niet goed" heb gedaan.
Heb je enig ander idee?
 
Ondertussen na veel proberen heb ik de volgende oplossing gevonden die 99% werkt.

Code: 
Private Sub btnTestMailing_Click()
    Dim outApp As Outlook.Application
    Dim outMail As Outlook.MailItem
    Dim sEmail As String
    Dim sVerzonden As String
    Dim iAantal As Integer
    Dim i As Integer
   
    Const sSubj As String = "TDDE - Jobopportuniteit - "
    Const sSQL As String = "SELECT [EMAIL_SOLLICITANT] FROM qry_sollicitant WHERE [SELECTEER_SOLLICITANT] = True ;"
            
On Error GoTo email_error
            
If Me.chkSelecteer = False Then
Msgbox "Je dient minstens 1 persoon te selecteren", , "Niemand geselecteerd"
End If

    Set outApp = CreateObject("Outlook.Application")
    Set outMail = outApp.CreateItemFromTemplate("c:\tmp\jobopportuniteit.oft")
                    
    sEmail = ""
    sVerzonden = ""
        
        With CurrentDb.OpenRecordset(sSQL)
        If Not .RecordCount = 0 Then
            .MoveLast
            .MoveFirst
            iAantal = .RecordCount
            Do While Not .EOF
                sEmail = sEmail & .Fields("EMAIL_SOLLICITANT").Value
                    If i < iAantal Then sEmail = sEmail & ";"
                    i = i + 1
            With outMail
                .To = ""
                .BCC = sEmail
                .Subject = sSubj
                .Display
             End With
                sVerzonden = sVerzonden & sEmail & ", "
                .MoveNext
            Loop
        End If
    End With

    Do While Right(sVerzonden, 2) = ", "
    sVerzonden = Left(sVerzonden, Len(sVerzonden) - 2)
    Loop
    Msgbox "Er is een mail gestuurd naar " & sEmail & "."
    Exit Sub


email_error:
Msgbox "" _
& vbCrLf & "Error-code: " & Str(Err.Number) _
& vbCrLf & "Error-omschrijving: " _
& vbCrLf & Err.Description, vbInformation, "Volgende fout werd vastgesteld !"

End Sub

De ene % die niet werkt is een raar verschijnsel:
bv er worden 10 records weergegeven --> ik selecteer er 5 -->druk op verzenden --> er worden 4 emailadressen aangemaakt in m'n outlook.
Anderzijds: ik de-selecteer de 5 geselecteerde records --> druk opnieuw op verzenden --> het ontbrekende emailadres wordt toch nog aangemaakt in een nieuwe email; tenzij ik het formulier sluit ; opnieuw open --> opnieuw druk op verzenden --> dan gebeurt er niets zoals het hoort.

Iemand enig idee wat er nog niet juist is in de VBA-code?
 
Laatst bewerkt:
Misschien?

Code: 
If i <[COLOR=#ff0000]​=[/COLOR] iAantal Then sEmail = sEmail & ";"
 
Ik vind je procedure een beetje vreemd, met name de volgorde waarin je dingen doet. En waarom niet in één keer één mail versturen? Je gebruikt tenslotte BCC en niet To. Ik zie ook dat je een string sVerzonden opbouwt, waar je niks mee doet. En het toevoegen van de puntkomma is ook heel vreemd. En zoals gezegd dus het gebruik van sVerzonden.
Dus hier mijn opzetje:
Code: 
Const sSQL As String = "SELECT [EMAIL_SOLLICITANT] FROM qry_sollicitant WHERE [SELECTEER_SOLLICITANT] = True AND [EMAIL_SOLLICITANT] Is Not Null;"
    With CurrentDb.OpenRecordset(sSQL)
        If Not .BOF = .EOF Then
            Do While Not .EOF
                If Not sEmail = vbNullString Then sEmail = sEmail & ";"
                If Not sVerzonden = vbNullString Then sVerzonden = sVerzonden & ", "
                sEmail = sEmail & !EMAIL_SOLLICITANT.Value
                sVerzonden = sVerzonden & !EMAIL_SOLLICITANT.Value
                .MoveNext
            Loop
            With outMail
                .BCC = sEmail
                .Subject = sSubj
                .Display
             End With
        End If
    End With
 
Deze mogelijkheid geeft weliswaar geen foutmelding; doch er wordt geen email aangemaakt.

Toevoeging puntkomma: is naar ik vermoed om een scheiding te maken tussen de verschillende email adressen: naam@mail.be;naam@mail.nl enz ...
 
In een mail kun je meerdere adressen zetten, mits die gescheiden zijn door het separatieteken. Dat is meestal een puntkomma, al accepteert Outlook ook wel een komma. Die puntkomma heb je alleen nodig als de string sEmail al een of meer adressen bevat, vandaar dat ik hem aan het begin check als ik email adressen toevoeg. Is hij leeg: geen ; (anders begint de string daarmee) anders dus er achter plakken.
Ik heb je db niet en je Outlook template ook niet, dus ik kan niet controleren of deze regels
Code: 
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
    Set outApp = CreateObject("Outlook.Application")
    Set outMail = outApp.CreateItemFromTemplate("c:\tmp\jobopportuniteit.oft")
correct worden uitgevoerd. Je kunt dat uiteraard makkelijk controleren door de loop in stapmodus door te lopen. Of in ieder geval het gedeelte vanaf With Outmail.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan