Const EMBED_ATTACHMENT As Long = 1454
[B]Const vaCopyTo As Variant = "" 'copy mailen naar: "adres"[/B]
Sub Testmail()
'Om een bijlage mee te sturen dient overal bij "Attachment" gerelateerd te worden verwijderd!
Dim vaRecipients As Variant
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String
Dim stFileName As String
If [Vragenformulier!H30] = "" Then MsgBox "Je hebt geen e-mailadres ingevuld in cel H30!": Exit Sub
Sheets("Vragenformulier").Select
If vbNo = MsgBox("Je staat op het punt om de bestuurder een bevestiging te mailen dat jij de verklaring in goede orde hebt ontvangen. " & vbCrLf & vbCrLf & "Verifieer voor de zekerheid nog wel even het e-mailadres (" & [H30] & ") voordat je de bevestiging gaat mailen!!! " & vbCrLf & vbCrLf & _
"Kan de mail worden verzonden? ", vbYesNo) Then Exit Sub
If vbNo = MsgBox("Heb je IBM-notus open staan?", vbYesNo) Then Exit Sub
If [Vragenformulier!R260] = "" Then [Vragenformulier!R260] = "Bevestigingsmail verstuurd"
'ActiveWorkbook.SaveAs Filename:=("S:\86\Mag-Data\Mit pc\davy\planning randstad\planning al door gemaild" & "\randstad Planning PostNL Cargo Belgie Turnhout Week " & Sheets("invulblad").Cells(1, 6).Value & " Doorgestuurd op " & Format(Now, "dd-mm-yyyy hh" & "u " & "mm") & ".xls")
'stpath = "C:\BEH\2. WAB onderzoeken\Instructies en voorbeelden\" 'locactie waar de bijlage staat
stsubject = "Briefbevestiging" '& Sheets("invulblad").Cells(5, 4).Value '& " Doorgestuurd op " & Format(Now, "dd-mm-yyyy hh" & "u " & "mm") & ".xls" _
vamsg = "Geachte " & [Aanhef] & Range("k20").Value & "," & vbCrLf & vbCrLf & _
"Hierbij bevestig ik dat ik uw verklaring in goede orde heb ontvangen, mijn dank hiervoor! " & vbCrLf & vbCrLf & _
"Met vriendelijke groet," & vbCrLf & vbCrLf & vbCrLf & _
[Naammedewerker].Value & vbCrLf & _
"..........................................................................." & vbCrLf & _
"M " & [Tel.nr.medewerker].Value & vbCrLf & _
"E " & [Emailmedewerker].Value
'Bijlagen meesturen
'Const stPath As String = "C:\BkH\1. Jaarrekening\DJ posten\"
'Const stPath As String = [Path].Value
'stFileName = "testbestand.xlsx" 'Bestandsnaam
stFileName = [Vragenformulier!A4] 'Bestandsnaam
'stFileName = "Informatie Wab-onderzoek.pdf" 'Bestandsnaam
'stAttachment = stPath & "\" & stFileName 'Pad
stAttachment = [Path].Value & stFileName & ".pdf" 'Pad, bestandsnaam en format
'stAttachment = stPath & "\" & stFileName & ".xlsx" 'Pad
'stPath = "C:\BEH\2. WAB onderzoeken\Instructies en voorbeelden" 'locactie waar de bijlage staat
'vaRecipients = VBA.Array("test1@test1.nl", "test2@test2.nl", "test@test.nl") 'mailadressen("eerste ontvanger" , "tweede ontvanger", enz.)
'vaRecipients = VBA.Array(Sheets("invulblad").Cells(5, 8).Value, Range("k16").Value)
vaRecipients = Sheets("Vragenformulier").Range("H30").Value 'E-mailadres
'vaRecipients = Sheets("invulblad").Cells(5, 8).Value, Range("k16").Value
'Bepaal de IBM Notes COM's Objecten.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'Als Lotus Notes niet open is open dan het mail-gedeelte ervan.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Maak de e-mail en de bijlage.
Set noDocument = noDatabase.CreateDocument
Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
'Voeg de gegevens toe aan de gemaakte e-mail eigenschappen.
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
.CopyTo = vaCopyTo
.Subject = stsubject
.Body = vamsg
.SaveMessageOnSend = True
.PostedDate = Now()
.Send 0, vaRecipients
End With
'Verwijder objecten uit het geheugen.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
MsgBox "De e-mail is correct verstuurd ", vbInformation
End Sub
