Neuer Termin mit Kontakt
Anwender von Outlook® 2007 vermissen unter anderem die Funktion Neuer Termin mit Kontakt, die in früheren Versionen noch enthalten war. Mit dem folgenden Codebeispiel lässt sich die Funktion jedoch wieder nachrüsten.
Zur Verwendung dieses Beispiels beachten Sie bitte die wichtigen Hinweise, sowie den Workshop VBA in Outlook® verwenden. Den Code bitte in ein neues Modul kopieren (Einfügen -> Modul im VBA-Editor).
Ab Outlook® 2000
Option Explicit Public Sub NewAppointmentWithContact() '===================================================================== ' Bildet die Funktion "Neuer Termin mit Kontakt" für Benutzer von ' Outlook® 2007 nach. ' (c) Peter Marchert - http://www.outlook-stuff.com/ ' 2008-11-21 Version 1.0.0 ' 2008-11-23 Version 1.0.1 '===================================================================== 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 = "Geschäftlich" ' Kategorie (mehrere ' durch ";" trennen) Const REMINDER As String = "30" ' Erinnerung in min Const MYDURATION As String = "60" ' Dauer in min Const PERSONAL As String = "" ' "Wahr", wenn Privattermin Const SHOWDIALOG As String = "Wahr" ' "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 = "Termin mit " & objContact.Subject '----------------------------------------------------------------- ' 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