vba zum prüfen von Termineinträgen

[djchaosbln]

Hallo in die Runde,

ich brauche bitte schnell Hilfe, der angehangene Code funktioniert nahezu Perfekt, allerdings möchte ich bevor der Termin erstellt wird, checken ob dort schon ein Termin existiert. Schön wäre dann dieser Termin dann gezeigt werden würde (ist nur ein wunsch ;) ) und eine MsgBox "text überleg ich dann". Optional vielleicht die Möglichkeit zu prüfen ob ein Termin mit gleichem Subject existiert. Ich hatte dazu schon mal eine Variante, tue mich aber schwer damit diese auf einen geteilten Ordner anzupassen. er kontrolliert immer meinen Standardkalender aber das nutzt mir nichts.

Sub Terminerstellen()

   
    Dim OutApp As Outlook.Application
    Dim apptOutApp As AppointmentItem
   

      'Verbindung/Referenz zu Outlook
      Set OutApp = CreateObject("Outlook.Application")
      'Termin erzeugen
      Set apptOutApp = OutApp.GetNamespace("MAPI").Folders("be-event@xxxxxxxxxxxx.com").Folders("Calendar").Items.Add(olAppointmentItem)
      'Termin Einstellungen vornehmen
      With apptOutApp
          'Starttermin
          .Start = CDate(Sheets("Grundlage").Cells(14, 4) & " " & CDate(Sheets("Grundlage").Cells(15, 4)))
          'Betreff, Termintitel
          .Subject = "" & (Sheets("HAngebot").Cells(18, 14))
          'Inhalt des Termins
          .Body = "Ort f?r Raumbuchung anklicken / Arbeitsblatt kopieren und einf?gen !!!"
          'Ort
          .Location = "" & (Sheets("HAngebot").Cells(20, 14))
          'Dauer in Minuten
          .Duration = "240"
          'Erinnerung vor Start in Minuten
          .ReminderMinutesBeforeStart = 10
          'Sound abspielen
          .ReminderPlaySound = True
          'Erinnerung setzen
          .ReminderSet = True
         
          'Speichern
          .Save
          'Anzeigen
          .Display
         
      End With
     
      Set OutApp = Nothing
    Set apptOutApp = Nothing
End Sub

Gefunden hatte ich dazu :

Sub Termin_pruefen()

Const olFolderCalendar As Integer = 9

Dim olApp As Object
Dim objNS As Object
Dim objFolder As Object
Dim objAlleTermine As Object
Dim objTermin As Object

Set olApp = CreateObject("Outlook.Application")
Set objNS = olApp.GetNameSpace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objAlleTermine = objFolder.Items

For Each objTermin In objAlleTermine
  If objTermin.Subject = "Geburtstag" Then
    MsgBox objTermin.Duration 'Ausgabe Länge in Minuten
  End If
Next

olApp.Quit

Set objTermin = Nothing
Set objAlleTermine = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set olApp = Nothing

End Sub

aber da weiss ich halt nicht wie ich dann den "Calendar" anspreche.

Ich danke schon mal für Eure Hilfe.

[LuckyJoe]

Hallo,

ich glaube, du solltest das im Outlook-Forum posten, nicht hier im Excel-Forum

Viel Erfolg.