Const EMBED_ATTACHMENT As Long = 1454
Const vaCopyTo As Variant = "" 'copy mailen naar: "adres"
Sub mail()
Dim vaRecipients As Variant
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
If vbNo = MsgBox("Ben je wel zeker dat je die mail wil verzenden", vbYesNo) Then Exit Sub
If vbNo = MsgBox("Heb je lotus notus open staan?", vbYesNo) Then Exit Sub
Application.DisplayAlerts = False
Sheets("adres").Select
ActiveWindow.SelectedSheets.Delete
Sheets("dokter").Select
ActiveWindow.SelectedSheets.Delete
Sheets("postcodes").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
ActiveSheet.Unprotect Password:="1230"
Cells.Select
Selection.Locked = True
Selection.FormulaHidden = False
Range("E11").Select
ActiveSheet.Protect Password:="1230", DrawingObjects:=True, Contents:=True, Scenarios:=True
With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
.DeleteLines 1, .CountOfLines
End With
ActiveSheet.Unprotect Password:="1230"
ActiveSheet.Shapes("Button 13").Select
Selection.Delete
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
ActiveWorkbook.SaveAs Filename:=("T:\Mag-Data\Mit pc\davy\Mensura Controle\controle al doorgemaild" & "\Controle aanvraag " & Sheets("controle").Cells(1, 14).Value & " Doorgestuurd op " & Format(Now, "dd-mm-yyyy hh" & "u " & "mm") & ".xls")
stpath = "T:\Mag-Data\Mit pc\davy\Mensura Controle\controle al doorgemaild" 'locactie waar bijlage staat
stsubject = "Controle aanvraag " & Sheets("controle").Cells(1, 14).Value & " Doorgestuurd op " & Format(Now, "dd-mm-yyyy hh" & "u " & "mm") & ".xls" _
vamsg = "Goedemorgen, " & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
" Bij deze stuur ik u een controle aanvraag voor een werknemer van ons." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
"Dit zit in een excel file die jullie kunnen afdrukken als jullie willen. " & vbCrLf & vbCrLf & _
"Het verslag van de controle arts mag naar het volgende mail adres gestuurd worden. " & vbCrLf & vbCrLf & _
" ffff@ttt.be" & vbCrLf & vbCrLf & _
" " & vbCrLf & vbCrLf & _
"Met Vriendelijke Groeten" & vbCrLf & vbCrLf & _
"De Hoofdmagazijniers"
'mailbody voorzien van gegevens
stfilename = "Dagstaat Magazijniers .xls" 'Bestandsnaam
stattachment = ("T:\Mag-Data\Mit pc\davy\Mensura Controle\controle al doorgemaild" & "\Controle aanvraag " & Sheets("controle").Cells(1, 14).Value & " Doorgestuurd op " & Format(Now, "dd-mm-yyyy hh" & "u " & "mm") & ".xls")
vaRecipients = VBA.Array("hhhh@hotmail.com", "hhs@hhf.be") 'mailadressen("eerste ontvanger" , "tweede ontvanger", enz.)
'Bepaal de Lotus 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
