1
Termin aus Excel per VBA in Outlook schreiben (Beschriftung setzen)
Hi,
ich habe ein kleines VBA Script geschrieben, dass Einträge aus einer zweiten Exceldatei einliest und diese als Termin in Outlook einpflegt. Jetzt möchte ich allerdings auch noch erreichen, dass der Termin eine entsprechende Beschriftung erhält (z.B. Urlaub und die entsprechende Färbung).
Soweit ich weiß funktioniert das über .Categories. Aber welche Parameter kann ich dem Befehl mitgeben?
Hier ist der Quelltext:
Sub Workbook_open()
'----------------------------------------------------------------------
'-------------------------- Import aus Excel ----------------------
'----------------------------------------------------------------------
Range("A3").Select
Workbooks.Open Filename:="c:\Temp\Excel_Import.xls" 'Öffnen der zu Importierenden Datei
'Worksheets("Tabelle1").
Range("A3:H30").Select 'Bereich A3 bis J100 markieren
Application.CutCopyMode = False
Selection.Copy
Windows("Outlook_Export.xls").Activate 'Wechsel auf Datei Gesamtliste
Worksheets("Datasheet").Range("A3:H30").Select
ActiveSheet.Paste 'Daten übertragen
Workbooks("Excel_Import.xls").Close SaveChanges:=False 'Schliessen der Datei ohne speichern
End Sub
Private Sub but_Export_Click()
'----------------------------------------------------------------------
'----------------------- Variablendeklarationen -----------------------
'----------------------------------------------------------------------
Dim OutApp As Object, apptOutApp As Object
Dim var_StartDatum As Date
Dim var_StartZeit As Date
Dim var_Subject As String
Dim var_Reminder As Boolean
Dim var_ReminderTime As Integer
Dim var_GanzerTag As Boolean
Dim var_Dauer As Integer
Dim var_Nachricht As String
Dim var_Location As String
Dim var_Body As String
Range("M20").Select
var_Body = ActiveCell.Value
'-----------------------------------------------------------------------
'------------------------- Füllen der Variablen ------------------------
'-----------------------------------------------------------------------
Range("A3").Select 'Starte von Zelle A3
Do Until ActiveCell.Value = "" 'Bis Zelle leer
Set OutApp = CreateObject("Outlook.Application")
Set apptOutApp = OutApp.CreateItem(1)
With apptOutApp
'----- Startdatum -----
var_StartDatum = Format(ActiveCell.Value, "dd/mm/yyyy")
'----- Wechsel der Zelle -----
ActiveCell.Offset(rowoffset:=0, columnoffset:=1).Activate
'----- Startzeit -----
var_StartZeit = Format(ActiveCell.Value, "hh:mm")
'----- Wechsel der Zelle -----
ActiveCell.Offset(rowoffset:=0, columnoffset:=1).Activate
'----- Terminbetreff -----
var_Subject = ActiveCell.Value
'----- Wechsel der Zelle -----
ActiveCell.Offset(rowoffset:=0, columnoffset:=1).Activate
'----- Ganztägiges Ereignis -----
If ActiveCell.Value = 1 Then
var_GanzerTag = True
ElseIf ActiveCell.Value = 0 Then
var_GanzerTag = False
End If
'----- Wechsel der Zelle -----
ActiveCell.Offset(rowoffset:=0, columnoffset:=1).Activate
'----- Termindauer wenn nicht ganztägig -----
var_Dauer = ActiveCell.Value
'----- Wechsel der Zelle -----
ActiveCell.Offset(rowoffset:=0, columnoffset:=1).Activate
'----- Ort -----
var_Location = ActiveCell.Value
'----- Wechsel der Zelle -----
ActiveCell.Offset(rowoffset:=0, columnoffset:=1).Activate
'----- Erinnerung aktivieren -----
If ActiveCell.Value = 1 Then
var_Reminder = True
ElseIf ActiveCell.Value = 0 Then
var_Reminder = False
End If
'----- Wechsel der Zelle -----
ActiveCell.Offset(rowoffset:=0, columnoffset:=1).Activate
'----- Zeit vor Termin bis Erinnerung -----
var_ReminderTime = ActiveCell.Value
'----- Wechsel der Zelle -----
'ActiveCell.Offset(rowoffset:=0, columnoffset:=-8).Activate
'----------------------------------------------------------------------
'------------------------- Export nach Outlook ------------------------
'----------------------------------------------------------------------
.Categories = "Kat"
'----- Termindatum und Startzeit (in min) -----
.Start = var_StartDatum & " " & var_StartZeit
'----- Zusätzlicher Text -----
.Body = var_Body
'----- Ort -----
.Location = var_Location
'----- Betreff -----
.Subject = var_Subject
'----- Ganztägiges Ereignis oder Ereignis mit bestimmter Dauer -----
If var_GanzerTag = False Then
.Duration = var_Dauer
ElseIf (var_Dauer > 1440) Or (var_GanzerTag = True) Then
.AllDayEvent = True
End If
'----- Erinnerung aktivieren -----
.ReminderSet = var_Reminder
'----- Zeit der Erinnerung vor Terminbeginn -----
.ReminderMinutesBeforeStart = var_ReminderTime
'----- Termin speichern -----
.Save
End With
'----- Nächste Zelle auswählen -----
ActiveCell.Offset(rowoffset:=1, columnoffset:=-7).Activate
'----- Variablen leeren -----
Set apptOutApp = Nothing
Set OutApp = Nothing
Loop
Range("M19").Select
MsgBox ActiveCell.Value
MsgBox "Outlook_Export.xls wird nun beendet / Outlook_Export.xls will be closed now"
'Range("M12").Select
'Workbooks(ActiveCell.Value).Close SaveChanges:=False
End Sub
Falls irgendwer ne Idee hat, wäre es super wenn er sich kurz melden würde.
Danke für eure Hilfe
Beste Grüße
D3ViLSEYE
ich habe ein kleines VBA Script geschrieben, dass Einträge aus einer zweiten Exceldatei einliest und diese als Termin in Outlook einpflegt. Jetzt möchte ich allerdings auch noch erreichen, dass der Termin eine entsprechende Beschriftung erhält (z.B. Urlaub und die entsprechende Färbung).
Soweit ich weiß funktioniert das über .Categories. Aber welche Parameter kann ich dem Befehl mitgeben?
Hier ist der Quelltext:
Sub Workbook_open()
'----------------------------------------------------------------------
'-------------------------- Import aus Excel ----------------------
'----------------------------------------------------------------------
Range("A3").Select
Workbooks.Open Filename:="c:\Temp\Excel_Import.xls" 'Öffnen der zu Importierenden Datei
'Worksheets("Tabelle1").
Range("A3:H30").Select 'Bereich A3 bis J100 markieren
Application.CutCopyMode = False
Selection.Copy
Windows("Outlook_Export.xls").Activate 'Wechsel auf Datei Gesamtliste
Worksheets("Datasheet").Range("A3:H30").Select
ActiveSheet.Paste 'Daten übertragen
Workbooks("Excel_Import.xls").Close SaveChanges:=False 'Schliessen der Datei ohne speichern
End Sub
Private Sub but_Export_Click()
'----------------------------------------------------------------------
'----------------------- Variablendeklarationen -----------------------
'----------------------------------------------------------------------
Dim OutApp As Object, apptOutApp As Object
Dim var_StartDatum As Date
Dim var_StartZeit As Date
Dim var_Subject As String
Dim var_Reminder As Boolean
Dim var_ReminderTime As Integer
Dim var_GanzerTag As Boolean
Dim var_Dauer As Integer
Dim var_Nachricht As String
Dim var_Location As String
Dim var_Body As String
Range("M20").Select
var_Body = ActiveCell.Value
'-----------------------------------------------------------------------
'------------------------- Füllen der Variablen ------------------------
'-----------------------------------------------------------------------
Range("A3").Select 'Starte von Zelle A3
Do Until ActiveCell.Value = "" 'Bis Zelle leer
Set OutApp = CreateObject("Outlook.Application")
Set apptOutApp = OutApp.CreateItem(1)
With apptOutApp
'----- Startdatum -----
var_StartDatum = Format(ActiveCell.Value, "dd/mm/yyyy")
'----- Wechsel der Zelle -----
ActiveCell.Offset(rowoffset:=0, columnoffset:=1).Activate
'----- Startzeit -----
var_StartZeit = Format(ActiveCell.Value, "hh:mm")
'----- Wechsel der Zelle -----
ActiveCell.Offset(rowoffset:=0, columnoffset:=1).Activate
'----- Terminbetreff -----
var_Subject = ActiveCell.Value
'----- Wechsel der Zelle -----
ActiveCell.Offset(rowoffset:=0, columnoffset:=1).Activate
'----- Ganztägiges Ereignis -----
If ActiveCell.Value = 1 Then
var_GanzerTag = True
ElseIf ActiveCell.Value = 0 Then
var_GanzerTag = False
End If
'----- Wechsel der Zelle -----
ActiveCell.Offset(rowoffset:=0, columnoffset:=1).Activate
'----- Termindauer wenn nicht ganztägig -----
var_Dauer = ActiveCell.Value
'----- Wechsel der Zelle -----
ActiveCell.Offset(rowoffset:=0, columnoffset:=1).Activate
'----- Ort -----
var_Location = ActiveCell.Value
'----- Wechsel der Zelle -----
ActiveCell.Offset(rowoffset:=0, columnoffset:=1).Activate
'----- Erinnerung aktivieren -----
If ActiveCell.Value = 1 Then
var_Reminder = True
ElseIf ActiveCell.Value = 0 Then
var_Reminder = False
End If
'----- Wechsel der Zelle -----
ActiveCell.Offset(rowoffset:=0, columnoffset:=1).Activate
'----- Zeit vor Termin bis Erinnerung -----
var_ReminderTime = ActiveCell.Value
'----- Wechsel der Zelle -----
'ActiveCell.Offset(rowoffset:=0, columnoffset:=-8).Activate
'----------------------------------------------------------------------
'------------------------- Export nach Outlook ------------------------
'----------------------------------------------------------------------
.Categories = "Kat"
'----- Termindatum und Startzeit (in min) -----
.Start = var_StartDatum & " " & var_StartZeit
'----- Zusätzlicher Text -----
.Body = var_Body
'----- Ort -----
.Location = var_Location
'----- Betreff -----
.Subject = var_Subject
'----- Ganztägiges Ereignis oder Ereignis mit bestimmter Dauer -----
If var_GanzerTag = False Then
.Duration = var_Dauer
ElseIf (var_Dauer > 1440) Or (var_GanzerTag = True) Then
.AllDayEvent = True
End If
'----- Erinnerung aktivieren -----
.ReminderSet = var_Reminder
'----- Zeit der Erinnerung vor Terminbeginn -----
.ReminderMinutesBeforeStart = var_ReminderTime
'----- Termin speichern -----
.Save
End With
'----- Nächste Zelle auswählen -----
ActiveCell.Offset(rowoffset:=1, columnoffset:=-7).Activate
'----- Variablen leeren -----
Set apptOutApp = Nothing
Set OutApp = Nothing
Loop
Range("M19").Select
MsgBox ActiveCell.Value
MsgBox "Outlook_Export.xls wird nun beendet / Outlook_Export.xls will be closed now"
'Range("M12").Select
'Workbooks(ActiveCell.Value).Close SaveChanges:=False
End Sub
Falls irgendwer ne Idee hat, wäre es super wenn er sich kurz melden würde.
Danke für eure Hilfe
Beste Grüße
D3ViLSEYE
Share on Facebook
Share on Twitter
Share on Reddit
Share on LinkedinPlease also mark the comments that contributed to the solution of the article
Content-Key: 63466
Url: https://administrator.de/contentid/63466
Printed on: April 26, 2024 at 11:04 o'clock
1 Comment
Hallo D3ViLSEYE
Vielen Dank für das Script, habe es angepasst und gleich ausprobiert
Mein Problem ist, ich muss alle Feiertage von 2010 automatisch vom Excel in den Outlook Kalender eintragen lassen, damit wir diese dann den Mitarbeitern verschicken können. Nun, durch die Anpassungen funktioniert's eigentlich nicht schlecht bis auf ein paar winzige Details. Da ich eine totale VBA Anfängerin bin, wäre ich um ein bisschen Hilfe sehr froh
Wir arbeiten mit Outlook 2007, da hat es bei den Terminen ne Option "Anzeigen als", diese müsste ich auf "Abwesend" setzen, ich habe es so gelöst:
Dim var_ShowAs As Integer
und dann unten:
'----- Anzeigen als -----
var_ShowAs = ActiveCell.Value
Ja ich weiss es ist kein Integer, da es ein Dropdown Feld mit Auswahl ist. Aber hab vieles probiert, nichts hat geklappt. Hättest du ne Idee?
Und gibt's auch die Möglichkeit, so was wie ne Abfrage zu machen wo prüft ob der Termin bereits vorhanden ist und wenn ja, diesen überschreibt?
Vielen Dank schon mal ;)
Grüsse
heuschrecke
Vielen Dank für das Script, habe es angepasst und gleich ausprobiert
Mein Problem ist, ich muss alle Feiertage von 2010 automatisch vom Excel in den Outlook Kalender eintragen lassen, damit wir diese dann den Mitarbeitern verschicken können. Nun, durch die Anpassungen funktioniert's eigentlich nicht schlecht bis auf ein paar winzige Details. Da ich eine totale VBA Anfängerin bin, wäre ich um ein bisschen Hilfe sehr froh
Wir arbeiten mit Outlook 2007, da hat es bei den Terminen ne Option "Anzeigen als", diese müsste ich auf "Abwesend" setzen, ich habe es so gelöst:
Dim var_ShowAs As Integer
und dann unten:
'----- Anzeigen als -----
var_ShowAs = ActiveCell.Value
Ja ich weiss es ist kein Integer, da es ein Dropdown Feld mit Auswahl ist. Aber hab vieles probiert, nichts hat geklappt. Hättest du ne Idee?
Und gibt's auch die Möglichkeit, so was wie ne Abfrage zu machen wo prüft ob der Termin bereits vorhanden ist und wenn ja, diesen überschreibt?
Vielen Dank schon mal ;)
Grüsse
heuschrecke