Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA: Termine von Excel nach Outlook schreiben oder löschen
#1
Hallo zusammen,

hätte schon wieder eine Frage an dieses tolle Forum.
Ich möchte aufgelistete Termine aus einem Tabellenblatt mittels VBA in den Qutlook-Kalender schreiben.
Im Netzt habe ich verschiedene Vorschläge gefunden die ich aber gerne noch etwas verändert hätte.
Mit dem folgenden Makro werden alle Termine von Excel nach Outlook übergeben. Das funktioniert sehr gut.
Bei der Übertragung jeden Termins wird in die letzte Excel-Spalte des jeweiligen  Termins die EntryID geschrieben.

Es soll bei einer Änderung eines Termins und der neuen Übertragung der alte Termin gelöscht werden um Doppeleinträge zu vermeiden.
Bzw. wie kann ich einen Löschvorgang für alle im Tabellenblatt aufgelisteten Termine in Outlook starten?
Gibt es eine Möglichkeit noch die Farb-Kategorie von Excel nach Outlook zu übergeben?

So hier nun das Makro:

Code:
Sub Excel_Control_Termin_nach_Outlook()
 Dim wksSheet As Worksheet
 Dim objFolder As Object
 Dim objOutApp As Object
 Dim objTermin As Object
 Dim lngRow As Long
 Dim LMinuten As Long
 
 On Error GoTo Fin
 Set wksSheet = ThisWorkbook.Worksheets("Spielpläne_VB") ' Anpassen!!!
 Set objOutApp = CreateObject("Outlook.Application")
 '9 = olFolderCalendar
 Set objFolder = objOutApp.GetNamespace("MAPI").GetDefaultFolder(9)
 
 For lngRow = 3 To Cells(Rows.Count, 1).End(xlUp).Row
   If Not fncPointExist(objFolder, wksSheet.Cells(lngRow, 2).Value) Then
     Set objTermin = objOutApp.CreateItem(1)
     
     'LMinuten = Format(wksSheet.Cells(lngRow, 4).Value, "h.mm")
     With objTermin
       'Starttermin (hier bswp.: Datum der Zelle um 14 Uhr)
       '.Start = Format(wksSheet.Cells(lngRow, 2).Value, "dd.mm.yyyy") & " 14:00"
       .Start = Format(wksSheet.Cells(lngRow, 2).Value, "dd.mm.yyyy") & " " & wksSheet.Cells(lngRow, 3).Value
       
       'Ende des Termins
       '.End = Format(wksSheet.Cells(lngRow, 2).Value, "dd.mm.yyyy") & " 20:00"
       '.End = Format(wksSheet.Cells(lngRow, 2).Value, "dd.mm.yyyy") '& " " & wksSheet.Cells(lngRow, 4).Value
       
       '.Subject = wksSheet.Cells(lngRow, 2).Value
       .Subject = wksSheet.Cells(lngRow, 1).Value
       
       'Inhalt des Termins
       .Body = "Das macht Spass!"
       'Ort
       .Location = wksSheet.Cells(lngRow, 5).Value & " - " & wksSheet.Cells(lngRow, 6).Value
       'Dauer in Minuten
       .Duration = wksSheet.Cells(lngRow, 4).Value
       'Erinnerung vor Start in Minuten
       .ReminderMinutesBeforeStart = 10
       'Sound abspielen
       .ReminderPlaySound = True
       'Erinnerung setzen
       .ReminderSet = True
       'Speichern
       .Save
       
       wksSheet.Cells(lngRow, 7) = .EntryID
       
     End With
     Set objTermin = Nothing
   End If
 Next lngRow
Fin:
 If Err.Number <> 0 Then MsgBox "Fehler: " & _
   Err.Number & " " & Err.Description
   Set objFolder = Nothing
   Set objTermin = Nothing
   Set objOutApp = Nothing
   If Err.Number = 0 Then MsgBox "Termine nach Outlook übertragen!"
End Sub

Private Function fncPointExist(ByVal objTMP As Object, _
 ByVal strSubject As String) As Boolean
 Dim objItem As Object
 For Each objItem In objTMP.Items
   If objItem.Subject = strSubject Then fncPointExist = True
 Next
End Function

Vielen Dank für alle Tipps!
Mit freundlichen Grüßen / Best regards
                          //
----------o00o---°(_)°---o00o----------------------

Erich
Antwortento top
#2
Hallöchen,

im Prinzip so:

Code:
Sub test2()
Dim wksSheet As Worksheet
Dim objFolder As Object
Dim objOutApp As Object
Dim objTermin As Object
Dim objNS As Object
'On Error GoTo Fin
Set wksSheet = ThisWorkbook.Worksheets("Spielpläne_VB") ' Anpassen!!!
Set objOutApp = CreateObject("Outlook.Application")
'9 = olFolderCalendar
Set objFolder = objOutApp.GetNamespace("MAPI").GetDefaultFolder(9)
Set objNS = objOutApp.GetNamespace("MAPI") 'Outlook.GetNamespace("MAPI")
Set objTermin = objNS.GetItemFromID(Cells(3, 7).Text)
objTermin.Delete
End Sub
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
[-] Folgende(r) 1 Benutzer sagt Danke an schauan für diesen Beitrag:
  • sharky51
Antwortento top
#3
Hallo André,

funktioniert super, vielen Dank!!!!!

Trotzdem nochmal die Frage ob es die Möglichkeit gibt noch eine Farb-Kategorie für einen Termin von Excel nach Outlook zu übergeben?

Vielen Dank für die Hilfe!
Mit freundlichen Grüßen / Best regards
                          //
----------o00o---°(_)°---o00o----------------------

Erich
Antwortento top
#4
Hi,

das würde ich auch mal probieren wollen, wie sieht denn so eine Terminliste in Excel aus?
Antwortento top
#5
Hallo Ralf,

ich hab mir den Code zum Termin eintragen angeschaut und dann die Tabelle so nachgebaut. Beim Ort werden die Inhalte zweier Zellen zusammengefasst. Die ID kommt vom Programm zum Termin eintragen.

Arbeitsblatt mit dem Namen 'Spielpläne_VB'
 ABCDEFG
2BetreffDatumZeitDauerOrtauch OrtID
3Testtermin aus Excel16.06.2016 00:0012:0030HierDa0000000075EBFAB4B2C4F64D9957CBB5849A44E2C4F52000

Hallo Sharky,

nach der Kategorie schaue ich morgen.
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top
#6
Hi André,

(02.06.2016, 20:08)schauan schrieb: ich hab mir den Code zum Termin eintragen angeschaut und dann die Tabelle so nachgebaut. Beim Ort werden die Inhalte zweier Zellen zusammengefasst. Die ID kommt vom Programm zum Termin eintragen.

ich habe es mit diesem Termin getestet, hier die Fehlermeldung:
   

Oder nur "Automatisierungsfehler" oder "Laufzeitfehler '440': Automatisierungsfehler"


Beim Original-Code kommt bei der Zeile .Start = Format(wksSheet...... die Fehlermeldung:
"Fehler 440: Das Objekt unterstützt diese Methode nicht."

Vielleicht könnte mal jemand eine funktionierende Datei anhängen?
Antwortento top
#7
Hallöchen,

für die "rote" Farbe hast Du eventuell die Kategorie "dringend" im Outlook. Dann geht das im Prinzip so:
Code:
'       'Erinnerung setzen
      .ReminderSet = True
      'Kategorie = Farbe
      .categories = "dringend"
      'Speichern
      .Save

Die komplette Datei ist im Anhang.


Angehängte Dateien
.xlsm   ExcelTermineOutlook.xlsm (Größe: 20,08 KB / Downloads: 25)
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
[-] Folgende(r) 1 Benutzer sagt Danke an schauan für diesen Beitrag:
  • sharky51
Antwortento top
#8
(03.06.2016, 15:11)schauan schrieb: Hallöchen,

für die "rote" Farbe hast Du eventuell die Kategorie "dringend" im Outlook. Dann geht das im Prinzip so:
Code:
'       'Erinnerung setzen
      .ReminderSet = True
      'Kategorie = Farbe
      .categories = "dringend"
      'Speichern
      .Save

Die komplette Datei ist im Anhang.

Hallo André,

das funktioniert ja jetzt alles super gut, vielen Dank!!!!

Eine Bemerkung hätte ich aber noch zu den "categories". Wenn Du da, wie in Deinem Beispiel "dringend" angibst, dann wird eine neue Kategorie in Outlook erzeugt ....aber der Termin wird nicht mit einer Farbe hinterlegt. Bei Eintrag z.B. "Rote Kategorie", dann wird der Termin auch rot hinterlegt.
Weißt Du vielleicht noch wo man nachlesen kann wie man die anderen Marker wie Wichtigkeit hoch/niedrig oder Serientyp usw. in das Makro einbaut?
Mit freundlichen Grüßen / Best regards
                          //
----------o00o---°(_)°---o00o----------------------

Erich
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste