Ganztägier Outlooktermin per VBA aus Excel versenden

Public Sub Versenden()

    Dim rng As Range
    Dim OutApp As Object
    Dim OutApptmt As Object
    Dim OutMail As Object
    Dim olOldBody As String


    'Schleife zum Speichern der Emailadressen in der Variablen Ausgabe  

    Dim Counter    As Long
    Dim MailAdressen As String
    
    With Sheets("Emails")  
    MailAdressen = ""  
    Counter = 2                                     'Coutner auf 2 setzen (2 Reihe)  
    Do                                              ' Schleifen-Anfang  
        MailAdressen = MailAdressen + .Cells(Counter, 3) + ";"    'Ausgabe  wird mit dem Wert aus Spalte B und entsprechender Reihe befüllt  
        Counter = Counter + 1                      ' Countern-Variable um 1 erhöhen  

    Loop Until .Cells(Counter, 1) = ""               ' Schleife verlassen wenn nächste Zelle leer ist.  

    If Cells(Counter, 1) = "" Then                  'Schleife Prüft ob aktuelle Zelle leer ist und wenn ja wird der letzte  
        MailAdressen = Left(MailAdressen, Len(MailAdressen) - 1)   ' " ; "entfernt  
    End If
    End With



    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
 
    Set rng = Nothing
    On Error Resume Next
    Set rng = Sheets(1).Range("A:A").SpecialCells(xlCellTypeVisible)  
    On Error GoTo 0
 
    If rng Is Nothing Then
        MsgBox "Kein Bereich markiert!", vbOKOnly  
        Exit Sub
    End If
 
    Set OutApp = CreateObject("Outlook.Application")  
    'Techniker  
    var_Techniker = Range("A2").Value  
    'Firma  
    var_Firma = Range("B2").Value  
    'Startdatum  
    'var_startdatum = Cells(4, 3)  
    'MsgBox (var_startdatum)  
    var_Startdatum = Format(Range("C2").Value, "dd.mm.yyyy")  
    'Enddatum  
    var_Enddatum = Format(Range("D2").Value + 1, "dd.mm.yyyy")  
    var_Enddatum1 = Format(Range("D2").Value, "dd.mm.yyyy")  
    'Enddatum Ausgabe  
    var_Enddatumausgabe = Format(Range("D2").Value, "dd.mm.yyyy")  
        
   Set OutApptmt = OutApp.CreateItem(1)
    With OutApptmt
        .Subject = var_Firma & " Techniker im Haus"  
        .Start = var_Startdatum
        .End = var_Enddatum
        'ganztägier Event  
        .AllDayEvent = True
        '.Save  
        Set OutMail = .ForwardAsVcal
    End With
 
    On Error Resume Next
    With OutMail
        .GetInspector.display
        Oldbody = .Body                     'Aktueller Body ( Signatur) wird als Oldbody gespeichert  
        .To = MailAdressen
        .cc = ""  
        .bcc = ""  
        
        'Zum Prüfen ob mehrere Tage oder nur ein Tag  
        If var_Startdatum = var_Enddatum1 Then
            
            .Subject = var_Firma & " Techniker - " & var_Techniker & " am: " & var_Startdatum & " im Haus"  
            
            .Body = "Hallo alle zusammen," & vbCrLf & vbCrLf & "am " & var_Startdatum & " wird Herr " & var_Techniker & _  
            " von der Firma " & var_Firma & " im Haus sein." & vbCrLf & Oldbody  
            'Body wird mit Text gefüllt und anschließend wird Oldbody ( Signatur) angehängt um eine Mail inkl. Signatur zu erhalten.  
            Else
            
            .Subject = var_Firma & " Techniker - " & var_Techniker & " von: " & var_Startdatum & " bis: " & var_Enddatumausgabe & " im Haus"  
            
            .Body = "Hallo alle zusammen," & vbCrLf & vbCrLf & "am " & var_Startdatum & " bis zum " & var_Enddatumausgabe & " wird Herr " & var_Techniker & _  
            " von der Firma " & var_Firma & " im Haus sein." & vbCrLf & Oldbody  
            'Body wird mit Text gefüllt und anschließend wird Oldbody ( Signatur) angehängt um eine Mail inkl. Signatur zu erhalten.  
        
        End If


        .display
        '.send 'automatisch senden ohne an zu zeigen  
    End With
    On Error GoTo 0
 
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub