Okay, here is my code. I didn't submit this in the first place, because in my
opinion the code is OK, but via a macro or a button on a form the loop is
created.
But here it is. thanks
Option Compare Database
Sub SendMessage(Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
' Maak de Outlook-sessie.
Set objOutlook = CreateObject("Outlook.Application")
' Maak het bericht.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Voeg de geadresseerden voor het vak Aan toe aan het bericht.
Set objOutlookRecip = .Recipients.Add("(e-mail address removed)")
objOutlookRecip.Type = olTo
' Voeg de geadresseerden voor het vak CC toe aan het bericht.
Set objOutlookRecip = .Recipients.Add("(e-mail address removed)")
objOutlookRecip.Type = olCC
' Stel het onderwerp, de berichttekst en de urgentie voor het bericht
in.
.Subject = "Dit is een test van Automatisering met Microsoft Outlook"
.Body = "Dit is echt de laatste test." & vbCrLf & vbCrLf
.Importance = olImportanceHigh 'Hoge urgentie
' Voeg bijlagen toe aan het bericht.
If Not
IsMissing("K:\l-Obvion\Concurrentieanalyse\Attachments\RenteBASIS.snp") Then
Set objOutlookAttach =
..Attachments.Add("K:\l-Obvion\Concurrentieanalyse\Attachments\RenteBASIS.snp")
Set objOutlookAttach =
..Attachments.Add("K:\l-Obvion\Concurrentieanalyse\Attachments\Rente125%.snp")
End If
' Zet de naam van elke geadresseerde om.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
End Sub
