Option Explicit

Public Sub GeburtstagsMail()
    Dim objNameSpace As NameSpace
    Dim objKalender As MAPIFolder
    Dim objEntwrfe As MAPIFolder
    Dim objTermin As Object   'AppointmentItem
    Dim strName As String
    Dim objNeueMail As MailItem
    Dim objVorlage As MailItem

    On Error Resume Next
    
    Set objNameSpace = Application.GetNamespace("MAPI")
    'Verweis auf Kalender-Ordner einrichten
    Set objKalender = objNameSpace.GetDefaultFolder(olFolderCalendar)
    'Verweis auf Entwrfe-Ordner einrichten
    Set objEntwrfe = objNameSpace.GetDefaultFolder(olFolderDrafts)
    
    'Alle Termine im Kalender durchlaufen
    For Each objTermin In objKalender.Items
        'Termine rausfiltern, die heute anstehen
        If CDate(Format(objTermin.Start, "short date")) = Date Then
            'Wenn Termin-Betreff den Schlsseltext "Geburtstag:" enthlt, dann...
            If InStr(objTermin.Subject, "Geburtstag:") > 0 Then
                '... Namen des Adressaten aus Betreff isolieren
                strName = Trim(Right(objTermin.Subject, Len(objTermin.Subject) - InStr(objTermin.Subject, ":")))
                
                'Neue Mail anlegen
                Set objNeueMail = Application.CreateItem(olMailItem)
                With objNeueMail
                    'Betreff festlegen
                    .Subject = "Happy Birthday!"
                    'Adressat hinzufgen (sollte vorhandener Kontakt sein)
                    .Recipients.Add strName
                    
                    'Verweis auf Entwurf mit dem Betreff "Happy Birthday!" anlegen
                    Set objVorlage = objEntwrfe.Items.Find("[Subject] = " & .Subject)
                    'Wenn Entwurf existiert, dann...
                    If Not objVorlage Is Nothing Then
                        '... dessen Text in neue Nachricht bernehmen
                        .Body = objVorlage.Body
                        
                    'Wenn Entwurf nicht existiert, dann...
                    Else
                        '... Standardtext festlegen
                        .Body = "Alles Gute zum Geburtstag!"
                    End If
                    
                    'Neue Nachricht zum manuellen Versand anzeigen
                    .Display
                End With
            End If
        End If
    Next
End Sub
