Autor: Rainer Beckerbauer (Ramses) --- Aus Excel VBA - Gruppe: Outlook & Excel
Weitere Artikel der Gruppe: Outlook & Excel Aus Excel VBA
Nach oben
ToDo
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.
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.
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
'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.
Mit diesem Beispiel können Sie sehr schnell Notizen in Outlook erstellen, ohne Outlook zu starten
oder nach Outlook wechseln zu müssen.
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
'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.
Dieses Thema hat weitere Beiträge
Outlook und Excel (1) Grundlagen und Einführung
Outlook und Excel (2) Workbooks und Worksheets versenden
Outlook und Excel (3) Serienmail mit Excel
Outlook und Excel (4) Aufgaben und Notizen erstellen
Outlook und Excel (5) Adressbuch und Kontakte
Outlook und Excel (6) Diagramme und Bereiche versenden
Outlook und Excel (1) Grundlagen und Einführung
Outlook und Excel (2) Workbooks und Worksheets versenden
Outlook und Excel (3) Serienmail mit Excel
Outlook und Excel (4) Aufgaben und Notizen erstellen
Outlook und Excel (5) Adressbuch und Kontakte
Outlook und Excel (6) Diagramme und Bereiche versenden
Weitere Artikel der Gruppe: Outlook & Excel Aus Excel VBA
Nach oben
Google Werbung
