Actieve sheet direct verzenden via Outlook

Sub Mailfactuur()
  
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
        
    Pad = "G:\DATA\"            'Map waar de te verzenden bestanden staan
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    Calculate
    
    Ontvanger = [K5].Value      'Inlezen gegevens uit Excel-bestand
    KopieNaam = [K6].Value
    BlindeKopieNaam = [K7].Value
    Onderwerp = [K8].Value
    Aanhef = [K11].Value
    Tekst = [K13].Value
    Afsluiting = [K19].Value
    Bestand = [K3].Value
        
      
    If Dir(Bestand) <> "" Then
        MsgBox "Het bestand: " & Bestand & ".pdf bestaat reeds"   ' Een controle om geen dubbel PDF-bestand te maken.
        Exit Sub  'Verlaat de routine als het PDF-bestand reeds bestaat.
     Else
    End If
    
    ActiveWorkbook.Save   'Bewaar het Excel-bestand
                                                                    'Exporteer het Excel-bestand naar PDF-formaat (het afdrukbare gebied)
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    Bestand, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
      
     
    With OutMail                                                    'Maak het mailtje aan
        .To = Ontvanger
        .CC = KopieNaam
        .BCC = BlindeKopieNaam
        .Subject = Onderwerp
        .Body = Aanhef & vbCr & vbLf & vbLf & _
                Tekst & vbCr & vbLf & vbLf & _
                Afsluiting
                
        .Attachments.Add Bestand
                
        .DeferredDeliveryTime = FactDatum & " 05:00"  'Stel verzenddatum uit tot tijdstip dat je meegeeft
        .ReadReceiptRequested = True                  'Ontvanstbevestiging = Aan
        .ReplyRecipientNames = ""                     'Eventueel afwijkend mailadres voor antwoorden.

        .Display    'Laat m in Outlook zien voor verzenden
        '.Send      'Verstuurt m meteen
        '.Save      'Bewaart m in de standaardmap voor concepten, verstuurt niet.
        
    End With
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    Ontvanger = ""
    KopieNaam = ""
    BlindeKopieNaam = ""
    Onderwerp = ""
    Aanhef = ""
    Tekst = ""
    Afsluiting = ""
    Bestand = ""

End Sub