Ich möchte aus freigegeben Outlook Kalendern Termine extrahieren und auflisten.


Aus Internetrescherchen habe ich folgende Code zusammengebastelt:

(Die "objOwner" und die "FromDate" und "ToDate" werden über ein Formular gespeist)


Dies funktioniert auch super. Allerdings, möchte ich die Daten in eine tabelle auflisten und nicht in ein MsgBox.


Hierzu habe ich die untere Teil wie folgt ersetzt:

  While TypeName(olApt) <> "Nothing"

    NextRow = 2



    With Sheets("Import")

        .Range("A2:F199").Value = ""

        .Range("A1:F1").Value = Array("Besitzer", "Termin", "Beginn", "Ende", "Dauer", "Ort")< _
br>


        For Each olApt In myAppointments.Items

            If (olApt.Start >= FromDate And olApt.Start <= ToDate) Then

                .Cells(NextRow, "A").Value = objOwner

                .Cells(NextRow, "B").Value = olApt.Subject

                .Cells(NextRow, "C").Value = CDate(olApt.Start)

                .Cells(NextRow, "D").Value = CDate(olApt.End)

                .Cells(NextRow, "D").NumberFormat = "HH:MM"

                .Cells(NextRow, "E").Value = olApt.End - olApt.Start

                .Cells(NextRow, "E").NumberFormat = "HH:MM"

                .Cells(NextRow, "F").Value = olApt.Location

                NextRow = NextRow + 1

            Else

            End If



        Next olApt



On Error GoTo 0

        .Columns.AutoFit



    End With



    Set olApt = Nothing

    Set myAppointments = Nothing

    Set olNS = Nothing

    Set olApp = Nothing

   Wend

cleanExit:

    Application.ScreenUpdating = True

    Exit Sub



ErrHand:

    'Add error handler

    Resume cleanExit

End Sub

Dies jedoch liefert nur den ersten Termin und sonst keine.


Was mache ich falsch? Kann mir jemand in die richtige Richtung schicken