Sub mailoutlook()
If [Reparatieaanvraag!B3] = "" Then MsgBox "Je hebt geen korte beschrijving gegeven, in max 3 woorden, doe dit in cel B3 ! Dit is nodig, want wat je hier invuld wordt meegenomen in de naam van het bestand !!!": Exit Sub
If [Reparatieaanvraag!C2] = "" Then MsgBox "Je hebt geen datum ingevuld,doe dit in cel C2 !": Exit Sub
If vbNo = MsgBox("Ben je wel zeker dat je die mail wil verzenden", vbYesNo) Then Exit Sub
'dit stukje vult de gegevens van blad 1 automatisch in op blad 2
Dim sh As Worksheet
Set sh = Sheets("reparatieaanvraag")
With Sheets("openstaande reparaties")
.Unprotect "0000"
.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 5) = Array(sh.[AZ1], sh.[AY1], sh.[b3], sh.[b4], sh.[b5])
.Protect "0000"
End With
Sheets("Reparatieaanvraag").Range("B" & Rows.Count).End(xlUp).Offset(, 49).Value = Application.UserName
pad = "G:\Pakketten\Everyone\Facilities\Reeds aangevraagd\" & Format(Sheets("Reparatieaanvraag").Range("AZ1"), "yyyy mm") & "\"
Bst = "Reparatieaanvraag voor " & Sheets("Reparatieaanvraag").[b3] & " " & Format(Sheets("Reparatieaanvraag").[AZ1], " DD MM YYYY HH MM ") & ".xls"
ActiveWorkbook.SaveAs Filename:=pad & Bst
With CreateObject("Outlook.Application").createitem(olMailItem)
.To = ""
.cc = "test@test.be"
.Subject = "Reparatie aanvraag " & Sheets("Reparatieaanvraag").[b3] & " " & Format(Sheets("Reparatieaanvraag").[AZ1], "DD MM YYYY HH MM") & ".xls"
.body = Replace("Beste Hendrik,##Bij deze stuur ik u een excel file waar in vermeld staat welke reparatie uitgevoerd zou moeten worden, bij . #Als je extra info hebt over het verder verloop van deze reparatie ,bv. wanneer ze deze komen uitvoeren of iets dergelijks , kan je deze mail dan beantwoorden aan iedereen ?#Zo is ineens iedereen op de hoogte van het verder verloop.#Als het nodig is dat dit bestand nog naar meer mensen moet worden gestuurd , geef dan even het mail adres door aan ##Met Vriendelijke Groeten## medewerker ###", "#", vbCr)
.Attachments.Add ThisWorkbook.Path & "\" & ThisWorkbook.Name
.Send
End With
ActiveSheet.Unprotect Password:="0000"
'dit stuk maakt de ingevulde velde terug leeg
Range("B3,B4,B5,B2").Select
Range("B5").Activate
Selection.ClearContents
'dit stukje verwijderd de foto's
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 3) <> "vst" Then shp.Delete
Next shp
ActiveSheet.Protect Password:="0000", DrawingObjects:=True, Contents:=True
Range("B3").Select
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=("G:\Pakketten\Everyone\Facilities\Doorgeven van reparaties richting Hendrik .xls")
MsgBox "De e - mail is correct verstuurd ", vbInformation
ActiveWorkbook.Save
ThisWorkbook.Saved = True
Application.Quit
End Sub