Outlook - Serientermine werden nicht ausgelesen

G

grays

Grünschnabel
Hallo Liebe Community,

ich möchte all meine Outlook Termine von einem gewissen Zeitraum (legt der Nutzer fest) und zu einem gewissen Thema nach Excel importieren. Mein Code funktioniert soweit auch super, jedoch werden die Serientermine nicht mit ausgelesen.
Es gibt eine Methode im Appointment Objekt von Outlook Namens IncludeRecurrences, welche einen Boolean Wert zurückgibt. Ist dieser wahr, sollten auch Serientermine ausgegeben werden. Leider wende ich diese Möglichkeit anscheinend falsch an.
Könnte sich jemand meinen Code angucken und evtl. Ergänzen, wenn er oder sie einen Ansatz hat?

Lieben Dank :)

Euer Ray

On Error Resume Next Set apl = New Outlook.Application With Sheets("Nachweis") .Cells.Delete start = InputBox("Startdatum") ende = InputBox("Enddatum") For Each apt In apl.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items organisatortest = InStr(1, apt.GetOrganizer, "Tesla") Subjekttest = InStr(1, apt.Subject, "Tesla") organisator = apt.GetOrganizer If organisatortest <> 0 Or Subjekttest <> 0 Then datspalter = Split(apt.start, " ") apt.IncludeRecurrences = True If datspalter(0) >= start Then If datspalter(0) <= ende Then i = i + 1 .Cells(i, 1) = apt.Subject .Cells(i, 2) = datspalter(0) .Cells(i, 3) = organisator End If End If End If Next End With On Error GoTo 0 End Sub
 
Ja, die F8-Taste ist dein Freund
Dein "Problem" ist "apt.IncludeRecurrences = True"
apt ist ein "Item" welches du in einer Items-Auflistung durchläufst

Nur die Items-Auflistung hat die Eigenschaft "IncludeRecurrences" (und muss wahrscheinlich zuerst gesetzt werden, bevor man in die Schleife springt)
Das Item selbst ("apt") hat nur die Eigenschaft "IsRecurring"

Nächstes: Was du mit den Datums-Angaben machst.
Du vergleichst Strings, und kein Datums-Format.
Lass das!
Wandle Start und Enddatum in "Date" um (CDate-Funktion), und schon brauchst du diesen seltsamen Split nicht mit datspalter.
Dann vergleichst du einfach nur gegen Int(apt.Start)
 
So, hab mal deinen Code "aufgeräumt"
Hinweis: Du solltest dir ne andere Methode suchen anstelle von InputBox.
InputBox gehört aus vba entfernt.
So wie der code jetzt ist, knallts in den zwei Zeilen, falls du ein ungültiges Datum eingibst


Kann natürlich nicht testen
Visual Basic: 
Sub Irgendwas()
Dim i As Long
Dim dStart As Date
Dim dEnde As Date
Dim oItems As Object
    Set apl = New Outlook.Application
    With Sheets(1)
        .Cells.Delete
        dStart = CDate(InputBox("Startdatum"))
        dEnde = CDate(InputBox("Enddatum"))
        Set oItems = apl.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
        oItems.IncludeRecurrences = True
        For Each apt In oItems
            If InStr(1, apt.GetOrganizer, "Tesla") > 0 Or InStr(1, apt.Subject, "Tesla") > 0 Then
                If Int(apt.Start) >= dStart And Int(apt.Start) <= dEnde Then
                    i = i + 1
                    .Cells(i, 1) = apt.Subject
                    .Cells(i, 2) = Int(apt.Start)
                    .Cells(i, 3) = apt.GetOrganizer
                End If
            End If
        Next
    End With
End Sub

Übrigens: Wie kann ein "Organisator" den Begriff "Tesla" im Namen haben????
 
Zvoni hat gesagt.:
So, hab mal deinen Code "aufgeräumt"
Hinweis: Du solltest dir ne andere Methode suchen anstelle von InputBox.
InputBox gehört aus vba entfernt.
So wie der code jetzt ist, knallts in den zwei Zeilen, falls du ein ungültiges Datum eingibst


Kann natürlich nicht testen
Visual Basic: 
Sub Irgendwas()
Dim i As Long
Dim dStart As Date
Dim dEnde As Date
Dim oItems As Object
    Set apl = New Outlook.Application
    With Sheets(1)
        .Cells.Delete
        dStart = CDate(InputBox("Startdatum"))
        dEnde = CDate(InputBox("Enddatum"))
        Set oItems = apl.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
        oItems.IncludeRecurrences = True
        For Each apt In oItems
            If InStr(1, apt.GetOrganizer, "Tesla") > 0 Or InStr(1, apt.Subject, "Tesla") > 0 Then
                If Int(apt.Start) >= dStart And Int(apt.Start) <= dEnde Then
                    i = i + 1
                    .Cells(i, 1) = apt.Subject
                    .Cells(i, 2) = Int(apt.Start)
                    .Cells(i, 3) = apt.GetOrganizer
                End If
            End If
        Next
    End With
End Sub

Übrigens: Wie kann ein "Organisator" den Begriff "Tesla" im Namen haben????
Zum Vergrößern anklicken....
Ich danke dir!!

Tesla habe ich nur benutzt, um meinen Firmen Namen nicht öffentlich zu zeigen.
 
Zvoni hat gesagt.:
So, hab mal deinen Code "aufgeräumt"
Hinweis: Du solltest dir ne andere Methode suchen anstelle von InputBox.
InputBox gehört aus vba entfernt.
So wie der code jetzt ist, knallts in den zwei Zeilen, falls du ein ungültiges Datum eingibst


Kann natürlich nicht testen
Visual Basic: 
Sub Irgendwas()
Dim i As Long
Dim dStart As Date
Dim dEnde As Date
Dim oItems As Object
    Set apl = New Outlook.Application
    With Sheets(1)
        .Cells.Delete
        dStart = CDate(InputBox("Startdatum"))
        dEnde = CDate(InputBox("Enddatum"))
        Set oItems = apl.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
        oItems.IncludeRecurrences = True
        For Each apt In oItems
            If InStr(1, apt.GetOrganizer, "Tesla") > 0 Or InStr(1, apt.Subject, "Tesla") > 0 Then
                If Int(apt.Start) >= dStart And Int(apt.Start) <= dEnde Then
                    i = i + 1
                    .Cells(i, 1) = apt.Subject
                    .Cells(i, 2) = Int(apt.Start)
                    .Cells(i, 3) = apt.GetOrganizer
                End If
            End If
        Next
    End With
End Sub

Übrigens: Wie kann ein "Organisator" den Begriff "Tesla" im Namen haben????
Zum Vergrößern anklicken....
Der Code klappt auch super, jedoch habe ich immer noch das Problem, dass Serientermine, die in dem Zeitraum stattfinden nicht mit ausgelesen werden. Hast du hierfür auch eine Lösung?
 
Hallo,

für die jenigen, die vor einem ähnlichen Problem stehen, hier die Lösung:

Visual Basic: 
On Error Resume Next

    Set apl = New Outlook.Application
    
    With Sheets(1)
    
        .Cells.Delete
        
        dStart = CDate(InputBox("Startdatum"))
        dEnde = CDate(InputBox("Enddatum"))
        
        Set oItems = apl.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
        
        oItems.Sort "[Start]"
        
        oItems.IncludeRecurrences = True
    
        For Each apt In oItems
        
        ende = Split(apt.End, " ")(0)
        
                If InStr(1, apt.GetOrganizer, "Tesla") > 0 Or InStr(1, apt.Subject, "Tesla") > 0 Then
                If Int(apt.start) >= dStart And Int(apt.start) <= dEnde Then
                If InStr(1, apt.Subject, "Abgesagt") = 0 Then
                    i = i + 1
                    .Cells(i, 1) = apt.Subject
                    .Cells(i, 2) = Int(apt.start)
                    .Cells(i, 3) = apt.GetOrganizer
                End If
            End If
            End If
            
            If ende > dEnde Then
            Exit For
            End If
            
            Next
            
    End With
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück