Folgendes VBA-Script lief bis jetzt tadellos, da der Standardkalender in Outlook benutzt wurde. Jetzt habe ich zusätzlich iCloud in Outlook 2013 eingebunden und möchte , dass neue Termine jetzt automatisch in den iCloud-Kalender werden:
Ich würde mich riesig freuen, wenn ich eine genaue Anleitung bekäme, wo im jetzigen Script was geändert werden muss - Vielen Dank schon einmal im Vorraus !
Public Sub NeuerTerminSicher()
Dim objCalendar As Outlook.MAPIFolder ' Standardkalender
Dim objContact As Outlook.ContactItem ' Kontakt
Dim objAppointment As Outlook.AppointmentItem ' Neuer Termin
'---------------------------------------------------------------------
' Nachfolgende Konstanten mit "" vorbelegen, wenn nicht gewünscht
'---------------------------------------------------------------------
Const MYCATEGORIES As String = "50+" ' Kategorie (mehrere
' durch ";" trennen)
Const REMINDER As String = "" ' Erinnerung in min
Const MYDURATION As String = "90" ' Dauer in min
Const PERSONAL As String = "" ' "Wahr", wenn Privattermin
Const SHOWDIALOG As String = "" ' "Wahr", wenn Kategorie-
' auswahl angezeigt werden
' soll
On Error Resume Next
'---------------------------------------------------------------------
' Aktuell geöffneten Kontakt refernzieren
'---------------------------------------------------------------------
Set objContact = Outlook.ActiveInspector.CurrentItem
'---------------------------------------------------------------------
' Ist kein Kontakt geöffnet, wird der gerade markierte verwendet
'---------------------------------------------------------------------
If objContact Is Nothing Then Set objContact = Outlook.ActiveExplorer.Selection(1)
'---------------------------------------------------------------------
' Auch kein Kontakt markiert?
'---------------------------------------------------------------------
If objContact Is Nothing Then
MsgBox "Bitte markieren bzw. öffnen Sie einen Kontakt." _
, vbCritical + vbOKOnly, "Neuer Termin mit Kontakt"
Exit Sub
End If
'---------------------------------------------------------------------
' Standardkalender referenzieren
'---------------------------------------------------------------------
Set objCalendar = Outlook.Session.GetDefaultFolder(olFolderCalendar)
'---------------------------------------------------------------------
' Neuen Termin erstellen
'---------------------------------------------------------------------
Set objAppointment = objCalendar.Items.Add
'---------------------------------------------------------------------
' Termin mit Werten füllen
'---------------------------------------------------------------------
With objAppointment
'-----------------------------------------------------------------
' Betreff festlegen
'-----------------------------------------------------------------
.Subject = "* " & objContact.Title & " " & objContact.LastName & " 50+"
.Location = objContact.Mileage
.Body = "Name: " & objContact.FullName & vbCrLf & objContact.MailingAddress & vbCrLf & "Priv.: " & objContact.HomeTelephoneNumber & vbCrLf & "Arb.: " & objContact.BusinessTelephoneNumber & vbCrLf & "Mob.: " & objContact.MobileTelephoneNumber & vbCrLf & "Mail: " & objContact.Email1Address
'-----------------------------------------------------------------
' Konstanten berücksichtigen
'-----------------------------------------------------------------
If MYCATEGORIES <> "" Then .Categories = MYCATEGORIES
If REMINDER <> "" Then .ReminderMinutesBeforeStart = CLng(REMINDER)
If MYDURATION <> "" Then .Duration = CLng(MYDURATION)
If PERSONAL <> "" Then .Sensitivity = olPrivate
'-----------------------------------------------------------------
' Kontakt als Link einfügen
'-----------------------------------------------------------------
Call .Links.Add(objContact)
'-----------------------------------------------------------------
' Termin anzeigen
'-----------------------------------------------------------------
.Display
'-----------------------------------------------------------------
' Dialog zur Kategorieauswahl anzeigen? (erst ab 2002)
'-----------------------------------------------------------------
If SHOWDIALOG <> "" Then .ShowCategoriesDialog
End With
'---------------------------------------------------------------------
' Referenzen löschen
'---------------------------------------------------------------------
Set objContact = Nothing
Set objAppointment = Nothing
Set objCalendar = Nothing
End Sub
|