Autor: Rainer Beckerbauer (Ramses)  --- Aus Excel VBA - Gruppe: Outlook & Excel

Outlook und Excel (4) Aufgaben und Notizen erstellen

Autor: Rainer Beckerbauer (Ramses) - Erstellt: --      - Letzte Revision: --Gruppenthema: 6 Folgen 1 2 3 4 5 6 Sie sind in Folge:4
Aufgabe in Outlook erstellen

In diesem Beispiel erstellen wir eine definierte Aufgabe zur späteren Nachbearbeitung
der gerade aktiven Datei an einem definierten Datum.

Dieses Makro können Sie in der persönlichne Arbeitsmappe "PERSONL.XLS" speichern,
dann steht es Ihnen dauerhaft zur Verfügung während einer EXCEL-Sitzung.

Sollte diese Datei noch nicht vorhanden sein, so können Sie diese erstellen indem Sie eine
Makroaufzeichnung starten "Extras - Makro - Makro aufzeichnen" und als Speicherort
"Persönliche Arbeitsmappe" wählen.
Diese Datei wird unter dem Namen "PERSONL.XLS" im Start-Verzeichnis von EXCEL gespeichert,
und bei jedem Programmstart automatisch geladen und ausgeblendet !!.
Alle Makros in dieser Datei stehen Ihnen jederzeit zur Verfügung.

Sub Excel_an_Outlook_Aufgabe()
    'Dieses Code-Beispiel sollte ab Outlook XP sicher funktionieren
    'O 2000 und O97 wurden nicht getestet
    'Einschaltung der Fehlerbehandlung
    On Error GoTo ErrorToDo
    'Verwendete Variablen
    Dim myToDo As Date, myDay As String, myRemBefore As Integer, myToInterVal
    Dim Qe As Integer
    Dim myLink As String
    Dim T1 As String, T2 As String, T3 As String, T4 As String
    Dim MyOlApp As Object, myJob As Object
    'In diesem Beispiel soll der Link auf die aktuelle Datei aufgenommen werden
    'um den Inhalt zum gewählten Termin nochmal nachbearbeiten zu können.
    'Der Link kann direkt in der Aufgabe angeklickt werden
    'Dateiname aufnehmen für einen späteren Link
    myLink = ActiveWorkbook.FullName
    'Ist kein Doppelpunkt vorhanden in "Fullname" wurde die Datei
    'noch nicht gespeichert, daher wird die weitere Verarbeitung
    'des Makros abgebrochen.
    If Mid(myLink, 2, 1) <> ":" Then
        MsgBox "Die Datei wurde noch nicht gespeichert"
        Exit Sub
    End If
    'Aufgabe erstellen heute in X Tagen
    'Erzwingen eines korrekten Wertes
    Do
        myDay = InputBox("In wieviel Tagen soll die Aufgabe erstellt werden ?", "Neue Aufgabe", 20)
    Loop While Not IsNumeric(CInt(myDay)) Or CInt(myDay) <= 0
    'Abbrechen wurde gewählt
    If myDay = "" Then Exit Sub
    'Aufgabetermin berechnen, dazu wird die "Texteingabe" aus der Inputbox
    'durch die Typumwandlung in eine "Integerzahl" umgewandelt,
    'mit der das zukünftige Datum berechnet werden kann.
    'aus dem Datum heraus
    myToDo = Date + CInt(myDay)
    '----
    'Alternativ die Eingabe eines Datums erzwingen
    'Hier wird die Datumseingabe explicit angefordert
    'Do
    ' myToDo = DateValue(InputBox("In wieviel Tagen soll die Aufgabe erstellt werden ?", "Neue Aufgabe", Format(Now + 21, "dd.mm.yyyy")))
    'Loop While Not IsDate(myToDo) Or myToDo < Now Or IsEmpty(myToDo)
    'If IsEmpty(myToDo) Then Exit Sub
    'Alternative Ende
    '----
    Select Case Weekday(myToDo, 2)
            'Würde berechnete Termin auf ein Wochenende fallen
            'so soll dies korrigiert werden
        Case Is > 5
            T1 = "Die Aufgabe würde auf ein Wochenende fallen: " & Format(myToDo, "DDDD DD.MMM.YY")
            T2 = "JA = Die Aufgabe wird auf den darauffolgenden Montag verschoben"
            T3 = "NEIN = Die Aufgabe auf den Freitag davor verlegt"
            T4 = "ABBRECHEN = Die Aufgabe wird am berechneten Termin eingefügt"
            Qe = MsgBox(T1 & Chr$(13) & T2 & Chr$(13) & T3 & Chr$(13) & T4, vbYesNoCancel, "Terminkorrektur")
            If Qe = vbYes Then
                'Termin auf Montag vorverlegen
                myToDo = myToDo + (8 - Weekday(myToDo, 2))
                ElseIf Qe = vbNo Then
                'Termin auf Freitag zurücklegen
                myToDo = myToDo - (7 - Weekday(myToDo, 2))
            End If
    End Select
    'Eigentliche Aufgabe erstellen
    'Objectvariablen zuweisen
    Set MyOlApp = CreateObject("Outlook.Application")
    'CreateItem(3) erstellt ein Aufgaben-Object
    Set myJob = MyOlApp.CreateItem(3)
    With myJob
        'Titel der Aufgabe
        .Subject = InputBox("Beschreibung der Aufgabe", "Aufgaben Titel", "Datei Nachbearbeiten !")
        'Datum wann die Aufgabe erledigt sein muss
        .DueDate = myToDo
        'Erinnerung in Tagen davor
        'In diesem Beispiel wird per default 1 Tag vorher,
        'bzw. am Freitag vor einem Montag informiert
        'Es werden jedoch max. 30 Tage Vorlaufzeit akzeptiert
        Do
            myRemBefore = 1
            myRemBefore = CInt(InputBox("Wieviel Tage davor:", "Erinnerung max. 30 Tage", myRemBefore))
        Loop While Not IsNumeric(myRemBefore) Or myRemBefore > 30
        Select Case Weekday(myToDo - myRemBefore, 2)
            Case 7
                myToDo = myToDo - 2
            Case 6
                myToDo = myToDo - 1
        End Select
        'Erinnerung einschalten !!!
        .ReminderSet = True
        'Für eine Reminder-Uhrzeit muss auch das Datum angegeben
        'werden, ansonsten Outlook den 1.1.1900 um 08:00 erinnert :-) !!
        'Uhrzeit definieren im Serialformat
        'Stunde, Minute, Sekunde
        .Remindertime = myToDo & " " & TimeSerial(8, 0, 0)
        'Der Einfachheit halber wird das Startdatum auf den gleichen Termin gesetzt
        .startDate = myToDo
        'Die Wichtigkeit der Aufgabe
        'Werte 1,2 und 3 zulässig
        .Importance = 2
        'Zwecks Optimierung können Sie auch gleich einen Link
        'auf ihre Datei erstellen die auf Ihrem Rechner oder Netzwerk liegt
        'Wird ein Dateilink mit "\\" erkennt Outlook automatisch dass es ein Link ist
        'Bei lokalen Dateien müssen sie den Zusatz "File:" davorsetzen
        'um den Link auf die Datei zu erzeugen
        'Der Pfad und Dateiname dürfen KEINE Leerzeichen enthalten
        'ansonsten wird der Link nicht korrekt dargestellt
        .Body = "Diese Datei muss nochmals bearbeitet werden:" & Chr$(13) & _
        "\\Server\ShareName\Ordner\" & ActiveWorkbook.Name & Chr$(13) & _
        "oder:" & Chr$(13) & "file://" & myLink
        'Die Aufgabe wird definitiv gespeichert
        .Save
    End With
    ErrorExit:
    Set myJob = Nothing
    Set MyOlApp = Nothing
    Exit Sub
    
    ErrorToDo:
    Select Case Err.Number
        Case 13
            'Ohne Information aus dem Makro aussteigen
            'Der Fehler 13 kommt bei einer Typ-Unverträglichkeit vor
            'also z.B. "Abbrechen" in einer Inputbox
            Resume ErrorExit
        Case Else
            'Information an den Benutzer
            MsgBox Err.Number & ";" & Err.Description
            'Abbruch des Makros
            Resume ErrorExit
    End Select
End Sub



Folgende Besonderheit ist hier beim Dateilink zu beachten:

Wird der Dateiname im Format "\\Servername\Freigabe\Dateiname.xls" übergeben, übernimmt EXCEL
diesen automatisch korrekt. Wird der Dateiname jedoch mit einer Laufwerksbezeichnung
"C:\Ordner\Dateiname.xls" übergeben, MUSS der Zusatz "File://" hinzugefügt werden, UND der Dateiname
darf KEINE Leerzeichen enthalten.

Alternativ kann ein anderer Dateiname MIT korrekter Pfadangabe auch über eine Inputbox angefordert werden.




Notiz in Outlook erstellen

Die "Body"-Eigenschaft in einer Notiz unterstützt nur die RTF-Funktionen.
HTML oder sonstige Anweisungen (Hyperlink usw.) können daher nicht verwendet werden.

Sub Excel_an_Outlook_Notiz()
    'Dieses Code-Beispiel sollte ab Outlook XP sicher funktionieren
    'O 2000 und O97 wurden nicht getestet
    'Einschaltung der Fehlerbehandlung
    On Error GoTo ErrorNote
    'Verwendete Variablen
    Dim myNoteText As String, myColor As Integer
    Dim MyOlApp As Object, myNote As Object
    'In diesem Beispiel soll eine Notiz aus EXCEL in Outlook erstellt werden
    myNoteText = InputBox("Bitte den Text der Notiz eingeben", "Neue Notiz", "Beispieltext")
    'oder eben alternativ den Inhalt der aktiven Zelle
    'myNoteText = ActiveCell.Text
    'Abbrechen wurde gewählt
    If myNoteText = "" Then Exit Sub
    'Eigentliche Notiz erstellen
    'Objectvariablen zuweisen
    Set MyOlApp = CreateObject("Outlook.Application")
    'CreateItem(5) erstellt ein Notizen-Object
    Set myNote = MyOlApp.CreateItem(5)
    With myNote
        'Inhalt der Notiz
        .Body = myNoteText
        'Color - Eigenschaft zur besseren Unterscheidung anfordern
        ' olBlue, olGreen, olPink, olWhite oder olYellow.
        Do
            myColor = Application.InputBox("Farbe der Notiz angeben:" & Chr$(13) & _
            "0 = Blau, 1 = Grün, 2 = Pink, 3 = Weiss, 4 = Gelb (Default)", "Notizfarbe", 4, Type:=1)
        Loop While myColor < 0 Or myColor > 4
        .Color = myColor
        'Die Aufgabe wird definitiv gespeichert
        .Save
    End With
    ErrorExit:
    Set myNote = Nothing
    Set MyOlApp = Nothing
    Exit Sub
    
    ErrorNote:
    Select Case Err.Number
        Case 13
            'Ohne Information aus dem Makro aussteigen
            'Der Fehler 13 kommt bei einer Typ-Unverträglichkeit vor
            'also z.B. "Abbrechen" in einer Inputbox
            Resume ErrorExit
        Case Else
            'Information an den Benutzer
            MsgBox Err.Number & ";" & Err.Description
            'Abbruch des Makros
            Resume ErrorExit
    End Select
End Sub


Mit diesem Beispiel können Sie sehr schnell Notizen in Outlook erstellen, ohne Outlook zu starten
oder nach Outlook wechseln zu müssen.




Weitere Artikel der Gruppe: Outlook & Excel Aus Excel VBA
Nach oben