Dim db As DAO.Database
Dim rsMail As DAO.Recordset
Dim objOutlook As Outlook.Application
Dim objMail As Outlook.MailItem
Dim sEmailVeld As String
Dim sOnderwerp As String
Dim sBodyFile As String
Dim sQueryNaam As String
Dim fso As FileSystemObject
Dim objBody As TextStream
Dim sTekst As String
Set fso = New FileSystemObject
sQueryNaam = "Typ hier de naam van de query die je wilt gebruiken"
sEmailVeld = "Typ hier de naam van het Emailveld dat je gebruikt voor de mailing"
' Stap 1: het onderwerp toewijzen.
sOnderwerp$ = Me.Onderwerp
' Gebruik onderstaande code als je het onderwerp via een Dialoogvenster wilt vullen.
''sOnderwerp$ = InputBox$("Typ hier het onderwerp van de mailing.", "Onderwerpregel is verplicht!")
' Als er geen onderwerp is, dan stoppen....
If sOnderwerp$ = "" Then
MsgBox "Geen onderwerp, dan ook geen mail..." & vbNewLine & vbNewLine & "We kappen er mee...", vbCritical, "E-Mail Merger"
Exit Sub
End If
' Vervolgens gebruiken we de tekst uit een tekstbestand als input voor het tekstdeel van de mail.
' Het tekstbestand kun je bijvoorbeeld via een dialoogvenster opzoeken in in het tekstvak zetten.
sBodyFile$ = Me.TekstBestand
' Gebruik onderstaande code als je het pad naar het bestand via een Dialoogvenster wilt vullen.
''sBodyFile$ = InputBox$("Geef het pad op naar het tekstbestand dat je wilt gebruiken als tekst.", "We Need A Body!")
' Als er geen Tekst is, dan stoppen....
If sBodyFile$ = "" Then
MsgBox "Geen tekstbestand, dan ook geen mail..." & vbNewLine & vbNewLine & _
"We kappen er echt mee...", vbCritical, "I Ain't Got No-Body!"
Exit Sub
End If
' Controleer eerst of het bestand wel bestaat...
If fso.FileExists(sBodyFile$) = False Then
MsgBox "Ik kan het bestand niet vinden... " & vbNewLine & vbNewLine & _
"Quitting...", vbCritical, "I Ain't Got No-Body!"
Exit Sub
End If
' We hebben een bestand; laten we de tekst dus maar gebruiken!
Set objBody = fso.OpenTextFile(sBodyFile, ForReading, False, TristateUseDefault)
' ... en die wordt dan in een variabele gezet.
sTekst = objBody.ReadAll
' en dan kan het tekstbestand weer dicht.
objBody.Close
' Volgende stap is een Outlook connectie maken.
Set objOutlook = New Outlook.Application
' En de database openen met de records uit de query of tabel
Set db = CurrentDb()
Set rsMail = db.OpenRecordset(QueryNaam)
''Set rsMail = db.OpenRecordset("MyEmailAddresses")
' En dan nu: door de records wandelen, en voor elk adres een mailtje sturen...
Do Until rsMail.EOF
' Alle ingrediënten instellen...
' Te beginnen met het Emailveld. Dit heb je meegegeven in de functie-aanroep.
objMail.To = rsMail(sEmailVeld)
objMail.Subject = sOnderwerp$
objMail.Body = sTekst
' Als je een bijlage mee wilt sturen, dan kun je één van de volgende regels gebruiken.
' objMail.Attachments.Add "c:\dbgout1.txt", olByValue, 1, "Zichtbare Naam 1"
' objMail.Attachments.Add "c:\dbgout2.txt", olByValue, 1, "Zichtbare Naam 2"
' Korte uitleg:
' "c:\myfile.txt" = het bestand dat mee moet.
' olByVaue = Hoe wordt het bestand bijgevoegd.
' olByValue is Document als bijlage, olByReference maakt een Snelkoppeling.
' De snelkoppeling werkt alleen als het bestand beschikbaar is (lokaal of op netwerk)
' 1 = zet de bijlage vooraan in de mail. Wordt vaak genegeerd door mailprogramma's
' "Zichtbare Naam 1" = Maakt de naam van de bijlage meer beschrijvend;
' i.p.v. "c:\dbgout1.txt" dus: "Rapport 4e Kwartaal"
' En hiermee wordt de mail verstuurd!
objMail.Send
' Als je de mail wilt zien, voordat je hem verstuurt, gebruik dan de volgende regel:
'objMail.Display
' En dan naar het volgende record...
rsMail.MoveNext
Loop
'Als laatste: alle variabelen opruimen.
Set objMail = Nothing
'Als je Outlook wilt afsluiten na het zenden, dan de volgende regel activeren.
'objOutlook.Quit
Set objOutlook = Nothing
rsMail.Close
Set rsMail = Nothing
db.Close
Set db = Nothing
End Sub
