cello249
Gebruiker
- Lid geworden
- 1 jul 2009
- Berichten
- 14
Hoi,
Ik heb een stuk code waarmee ik de agenda-items uit outlook (2016) kan importeren in Excel.
Dat werkt prima op 1 onderdeel na.
Terugkerende afspraken worden alleen meegenomen:
1) Als de startdatum is gelegen in de opgevraagde periode
2) dan wordt hij maar 1x vermeldt en dus niet, als de afspraak dagelijks is, elke dag opnieuw in een regel vermeld
Ik heb allerlei mogelijkheden geprobeerd met recurring.items maar het lukt mij niet om voor elkaar te krijgen dat alle agenda items ook zichtbaar worden in excel.
De code is
Kunnen jullie mij op weg helpen?
Alvast bedankt.
Ik heb een stuk code waarmee ik de agenda-items uit outlook (2016) kan importeren in Excel.
Dat werkt prima op 1 onderdeel na.
Terugkerende afspraken worden alleen meegenomen:
1) Als de startdatum is gelegen in de opgevraagde periode
2) dan wordt hij maar 1x vermeldt en dus niet, als de afspraak dagelijks is, elke dag opnieuw in een regel vermeld
Ik heb allerlei mogelijkheden geprobeerd met recurring.items maar het lukt mij niet om voor elkaar te krijgen dat alle agenda items ook zichtbaar worden in excel.
De code is
Code:
Option Explicit
Sub ListAppointments()
Dim olApp As Object
Dim olNS As Object
Dim olFolder As Object
Dim olApt As Object
Dim NextRow As Long
Dim FromDate As Date
Dim ToDate As Date
FromDate = CDate("02/25/2019")
ToDate = CDate("05/30/2019")
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number > 0 Then Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(9) 'olFolderCalendar
NextRow = 2
With Sheets("Gegevens") 'Change the name of the sheet here
.Range("A1:D1").Value = Array("Project", "Date", "Time spent", "Location")
For Each olApt In olFolder.Items
If (olApt.Start >= FromDate And olApt.Start <= ToDate) Then
If olApt.Location <> "Nederland" Then 'als Nederlandse feestdag dan overslaan
.Cells(NextRow, "A").Value = olApt.Subject
.Cells(NextRow, "B").Value = CDate(olApt.Start)
.Cells(NextRow, "C").Value = olApt.End - olApt.Start
.Cells(NextRow, "C").NumberFormat = "HH:MM:SS"
.Cells(NextRow, "D").Value = olApt.Location
.Cells(NextRow, "E").Value = olApt.Categories
NextRow = NextRow + 1
Else
End If
End If
Next olApt
.Columns.AutoFit
End With
Set olApt = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Sub
Kunnen jullie mij op weg helpen?
Alvast bedankt.