Termin in geteiltem Kalender prüfen
19.02.2019 11:14:22
Rico
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.