Vielen Dank an alle in diesem Forum, welche mir Ihre Zeit schenken und sich mit meinen Problemen befassen! Ich weiß das ernsthaft zu schätzen und danke allen, die sich mit dieser Frage befassen herzlich!!!

Public Sub MakeTerm(ByVal sTermin As Date, ByVal sBetreff As String)
   Dim objTerm As AppointmentItem
 
   Set objTerm = Outlook.Application.CreateItem(olAppointmentItem)
   With objTerm
      .Start = sTermin
      .Subject = sBetreff
      .Categories = "aaa"
      .ReminderMinutesBeforeStart = 0 'keine Erinnerung
      .ReminderSet = False
      .Save
   End With
 
   Set objTerm = Nothing
End Sub

Vielen Dank an alle in diesem Forum, welche mir Ihre Zeit schenken und sich mit meinen Problemen befassen! Ich weiß das ernsthaft zu schätzen und danke allen, die sich mit dieser Frage befassen herzlich!!!

Public WithEvents MyTerm As Outlook.AppointmentItem
Public MyGlobCol As New Collection
 
Private Sub Application_Startup()
    Set MyTerm = Application.CreateItem(olAppointmentItem)
    MyGlobCol.Add MyTerm, "GlobalTerm"
End Sub

Vielen Dank an alle in diesem Forum, welche mir Ihre Zeit schenken und sich mit meinen Problemen befassen! Ich weiß das ernsthaft zu schätzen und danke allen, die sich mit dieser Frage befassen herzlich!!!

Vielen Dank an alle in diesem Forum, welche mir Ihre Zeit schenken und sich mit meinen Problemen befassen! Ich weiß das ernsthaft zu schätzen und danke allen, die sich mit dieser Frage befassen herzlich!!!

Public Sub MakeTerm()
   Dim objTerm As AppointmentItem
   Dim objSerie As RecurrencePattern
   Dim Geburtsdatum As Date            'Geburtsdatum
   Dim name As String                   'Vorname Name
   Dim sTermin As Date                  'Datum des Ereignis
   Dim sBetreff As String               'Betreff des Ereignis
 
   'Daten aufnehmen
   name = InputBox("Name (Vorname Nachname)")
   Geburtsdatum = InputBox("Geburtstag (tt.mm.jjjj): ")
   If IsDate(Geburtsdatum) = False Then Exit Sub
   sTermin = Format(Geburtsdatum, "dd.mm.yyyy")
   sBetreff = name & " (" & Format(Geburtsdatum, "dd.mm.yy") & ")"
 
   'Ereignisserie erstellen
   Set objTerm = Outlook.Application.CreateItem(olAppointmentItem)
   With objTerm
      .AllDayEvent = True
      .Start = sTermin
      .Subject = sBetreff
      .Categories = "Geburtstag"
      .ReminderMinutesBeforeStart = 0 'keine Erinnerung
      .ReminderSet = False
   End With
 
   Set objSerie = objTerm.GetRecurrencePattern
   With objSerie
        .PatternStartDate = sTermin
        .RecurrenceType = olRecursYearly
   End With
 
   objTerm.Save             'Objekt wird gespeichert
   'objTerm.Display          'Objekt wird angezeigt
 
   Set objTerm = Nothing
   Set objSerie = Nothing
   MsgBox ("Das Serienereignis zum Geburtstag von " & name & " wurde angelegt." _
     & Chr$(13) & "Es wurde jedes Jahr am " & Format(Geburtsdatum, "dd.mm.") & _
     " ab dem Jahr " & Format(Geburtsdatum, "yyyy") & " in den Kalender" & _
     "eingetragen.")
End Sub

Vielen Dank an alle in diesem Forum, welche mir Ihre Zeit schenken und sich mit meinen Problemen befassen! Ich weiß das ernsthaft zu schätzen und danke allen, die sich mit dieser Frage befassen herzlich!!!

Vielen Dank an alle in diesem Forum, welche mir Ihre Zeit schenken und sich mit meinen Problemen befassen! Ich weiß das ernsthaft zu schätzen und danke allen, die sich mit dieser Frage befassen herzlich!!!

 
         Dim OutlookApp As Outlook.Application
         Dim OutlookMAPI As NameSpace
         Dim OutlookCalendar As MAPIFolder
         Dim OutlookAppt As Outlook.AppointmentItem
         Dim OutlookUser As Outlook.Recipient
 
         strColorNotiz="Telefonnotiz"
 
 
                      'Set OutlookApp = GetObject(, "Outlook.Application")
40                    Set OutlookApp = New Outlook.Application
50                    Set OutlookMAPI = OutlookApp.GetNamespace("MAPI")
 
60                       Set OutlookUser = OutlookMAPI.CreateRecipient( _
  "m.mustermann@provider.de") 'Text durch gültige Emailadresse ersetzen
70                       OutlookUser.Resolve
80                       Set OutlookCalendar = _
  OutlookMAPI.GetSharedDefaultFolder(OutlookUser, olFolderCalendar)
 
90                    Set OutlookAppt = OutlookCalendar.Items.Add
 
100                      With OutlookAppt
110                           .Subject = frmTelefonnotiz.txtBetreff
120                           .Body = frmTelefonnotiz.txtBody
130                           .Start = CDate(frmTelefonnotiz.xpDTPicker_Datzum( _
  0).Text & " " & Format(frmTelefonnotiz.xpcmbZeit(0).Text, "hh:mm"))  'Beginnt 
' am
140                           .End = CDate(frmTelefonnotiz.xpDTPicker_Datzum( _
  1).Text & " " & Format(frmTelefonnotiz.xpcmbZeit(1).Text, "hh:mm"))  'Endet am
                '             .Duration = 30       'Länge des Termins in Minuten
150                           .ReminderSet = True   'Erinnerung setzen
160                           .ReminderMinutesBeforeStart = fncReminderMinutes( _
  frmTelefonnotiz.xpcmbZeit(2).Text)
170                           .Categories = strColorNotiz
180                           .Save
 
190                      End With
 
 
200                      Set OutlookApp = Nothing
210                      Set OutlookAppt = Nothing
220                      Set OutlookItem = Nothing
230                      Set OutlookCalendar = Nothing
240                      Set OutlookMAPI = Nothing
250                      Set OutlookUser = Nothing