Termine von Excel nach Outlook übertrage

Hallo Zusammen,
ich habe eine Kontrollliste in der in den Zellen J - M Daten stehen, die per Makro nach Outlook übertragen werden sollen. Leider komme ich mit dem Code für das Makro nicht weiter.
Zum Problem:
Es werden nur die Daten J8 M8 übertragen aber nicht die Daten aus J14 M14 und auch nicht die Daten aus J19 M19.
Außerdem werden die Daten bei jedem Klick auf das Makro erneut als Doppellungen nach Outlook übertragen, was nicht sein soll.
Ziel:
Es sollen alle Daten die in den Zellen J M stehen nach Outlook übertragen werden. Es sollen keine Doppelungen stattfinden, sondern die Daten sollen überschrieben werden.
Info:
Wenn ein Termin stattgefunden hat, wird die ganze Zeile gelöscht und eine neue eingefügt. Die Liste wird ständig nach demselben Schema fortgeführt.
Vielleicht kann mir jemand behilflich sein.
Die Datei mit dem Code habe ich angehängt.
Liebe Grüße Tobi
https://www.herber.de/bbs/user/136674.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Tobi,
hier mal eine Anpassung Deines codes, der mehrere Termine einträgt und sich die Eintragung in der Liste merkt. Spalte "O" ggf. ausblenden.
Das Löschen der Termine in der Vergangenheit habe ich nicht programmiert, aber es erfolgt ein Hinweis.
Vielleicht hilft es Dir ja weiter...

Sub Termine_von_Excel_nach_Outlook_exportieren()

 Dim OutApp As Object, apptOutApp As Object, WSh As Worksheet, AC As Range

 Dim iZeile As Long

 Set WSh = Sheets("Interessentenliste")

'Termine aus Excel-Sheet lesen

 Set OutApp = CreateObject("Outlook.Application")

 For iZeile = 2 To WSh.UsedRange.Rows.Count

  If WSh.Cells(iZeile, "J").Value Like "Datum" Then

   Set AC = WSh.Cells(iZeile + 1, "J")

   If Date &GT; CDate(AC.Value) Then

      MsgBox "Der Termin vom " & AC.Value & " liegt in der Vergangenheit. Bitte löschen"

   Else

    If AC.Offset(0, 5).Value = "" Then

     Set apptOutApp = OutApp.CreateItem(1)

     With apptOutApp

      'Termine werden aus den Zellen gelesen

      .Start = Format(AC.Value, "dd.mm.yyyy") & _

         " " & Format(AC.Offset(0, 1).Value, "hh:mm")

      .Subject = AC.Offset(0, 2).Value

      'Zusätzlicher Text

      .Body = ""

      'Ort

      .Location = AC.Offset(0, 3).Value

      'Dauer des Ereignisses (hier 1 Stunde)

      .Duration = "60"

      'Erinnerung: 24 Stunden = 1440 Minuten vor Ereignis

      .ReminderMinutesBeforeStart = 1440

      'Erinnerungsfunktion mit Sound

      .ReminderPlaySound = True

      'Erinnerung wiederholen

      .ReminderSet = True

     'Termin speichern

      .Save

     End With

     Set apptOutApp = Nothing

     AC.Offset(0, 5).Value = "eingetragen"

    End If

   End If

  End If

 Next iZeile

 Set OutApp = Nothing

 MsgBox "Alle neuen Termine wurden in Outlook eingetragen!", vbInformation, "Outlooktermine eintragen"

End Sub

viele Grüße
Karl-Heinz

Beliebteste Forumthreads (12 Monate)

Termine von Excel nach Outlook übertrage

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread