Neue Aufgabe mit Kontakt
Ähnlich dem Programmierbeispiel Neuer Termin mit Kontakt, finden Sie hier die Funktion "Neue Aufgabe mit Kontakt".
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 NewTaskWithContact() '===================================================================== ' Erstellt eine Aufgabe zum geöffneten bzw. markiertem Kontakt. ' (c) Peter Marchert - http://www.outlook-stuff.com/ ' 2008-12-07 Version 1.0.0 '===================================================================== Dim objTasks As Outlook.MAPIFolder ' Aufgabenordner Dim objTask As Outlook.TaskItem ' Neue Aufgabe Dim objContact As Outlook.ContactItem ' Kontakt '--------------------------------------------------------------------- ' Nachfolgende Konstanten mit "" vorbelegen, wenn nicht gewünscht '--------------------------------------------------------------------- Const MYCATEGORIES As String = "Geschäftlich" ' Kategorie (mehrere ' durch ";" trennen) Const PERSONAL As String = "" ' "Wahr", wenn Private Aufgabe 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, "Neue Aufgabe mit Kontakt" Exit Sub End If '--------------------------------------------------------------------- ' Aufgabenordner referenzieren '--------------------------------------------------------------------- Set objTasks = Outlook.Session.GetDefaultFolder(olFolderTasks) '--------------------------------------------------------------------- ' Neue Aufgabe erstellen '--------------------------------------------------------------------- Set objTask = objTasks.Items.Add '--------------------------------------------------------------------- ' Aufgabe mit Werten füllen '--------------------------------------------------------------------- With objTask '----------------------------------------------------------------- ' Betreff festlegen '----------------------------------------------------------------- .Subject = "Aufgabe mit " & objContact.Subject '----------------------------------------------------------------- ' Konstanten berücksichtigen '----------------------------------------------------------------- If MYCATEGORIES <> "" Then .Categroies = MYCATEGORIES If PERSONAL <> "" Then .Sensitivity = olPrivate '----------------------------------------------------------------- ' Kontakt als Link einfügen '----------------------------------------------------------------- Call .Links.Add(objContact) '----------------------------------------------------------------- ' Aufgabe anzeigen '----------------------------------------------------------------- .Display '----------------------------------------------------------------- ' Dialog zur Kategorieauswahl anzeigen? (erst ab 2002) '----------------------------------------------------------------- If SHOWDIALOG <> "" Then .ShowCategoriesDialog End With '--------------------------------------------------------------------- ' Referenzen löschen '--------------------------------------------------------------------- Set objContact = Nothing Set objTask = Nothing Set objTasks = Nothing End Sub