06. februar 2017 - 19:22Der er
11 kommentarer og 1 løsning
Brug af MS Access til Extract af Outlook Calendar Appointments
Hej Eksperter,
Jeg har et par udfordringer som jeg ikke kan løse.
Jeg har fået en opgave, hvor jeg skal udtrække alle aftaler fra en bunke Delte kalendere i Outlook 2013. Jeg kan sagtens se kalenderne og alle aftaler men har følgende 2 store udfordringer:
Første udfordring er at jeg ikke kan få "Restrict" til at virke, så istedet for et udsnit af aftaler får jeg hver gang alle aftaler.
Det er denne kode jeg basalt set bruger:
Dim oOutlook As Outlook.Application Dim oNs As Outlook.namespace Dim appt As Outlook.AppointmentItem Dim objOwner As Outlook.recipient Dim str_sql As String Dim STR_OWNER As String Dim item_Start_date As String Dim item_Start_time As String Dim app_Start As Date Dim app_End As Date Dim FolderCal As Object Dim i As Long Dim strRestriction As String Dim myStart As Date Dim myEnd As Date Const olFolderCalendar = 9 myStart = C_DATE myEnd = C_DATE
strRestriction = "[Start] >= '" & Format(Date, "yyyy/mm/dd") & "' AND [Start] <= '" & Format(Date + 14, "yyyy/mm/dd") & "'" Set oOutlook = New Outlook.Application Set oNs = oOutlook.GetNamespace("MAPI") STR_OWNER = "Thomas" Set objOwner = oNs.CreateRecipient(STR_OWNER) objOwner.Resolve If objOwner.Resolved Then Set FolderCal = oNs.GetSharedDefaultFolder(objOwner, olFolderCalendar) End If Set ItemsApt = FolderCal.Items ItemsApt.IncludeRecurrences = True ItemsApt.Sort "[Start]" Set oItemsInDateRange = ItemsApt.Restrict(strRestriction) oItemsInDateRange.IncludeRecurrences = True oItemsInDateRange.Sort "[Start]" For Each appt In oItemsInDateRange
Næste problem jeg har er med Gentagene aftaler "Recurrences" Det "eneste" jeg ønsker er at tage all Gentagene aftaler ud på de præcise dage og tidspunkter som også kan ses når man åbner kalenderen. Men jeg får konstant "Master" aftalens start og slut dato og tidspunkter. Jeg har nu søgt højt og lavt i 2 uger på nettet og har nu kastet håndklædet i ringen og det er derfor jeg henvender mig til jer herinde.
På forhånd 1000 1000 1000 tak for alt den hjælp jeg kan få.
The code your showing now isn't the same as the first, any chance of you sending the full code you are using as I'll need to debug through code to try and find problem.
ekspertenATsanthell.dk AT = @
I'll be gone for an hour or so, will look again later
Function loop_period() Dim loop_Date As Date loop_Date = Date
Do Until loop_Date = Date + 14 'Debug.Print "New Period: " & loop_Date get_calendar loop_Date loop_Date = loop_Date + 1 Loop Debug.Print "Done" End Function
Function get_calendar(C_DATE As Date) On Error GoTo err Dim oOutlook As Outlook.Application Dim oNs As Outlook.namespace Dim appt As Outlook.AppointmentItem Dim objOwner As Outlook.recipient Dim str_sql As String Dim STR_OWNER As String Dim item_Start_date As String Dim item_Start_time As String Dim app_Start As Date Dim app_End As Date
Dim FolderCal As Object Dim Occur As Object Dim i As Long Dim strRestriction As String Dim myStart As Date Dim myEnd As Date Const olFolderCalendar = 9
myStart = C_DATE myEnd = C_DATE
strRestriction = "[Start]>= '" & Format$(C_DATE & " 00:01", "dd/mm/yyyy hh:mm AM") & "' AND [Start] <= '" & Format$(C_DATE & " 11:59", "dd/mm/yyyy hh:mm PM") & "'" 'Debug.Print "Restriction: " & strRestriction Set oOutlook = New Outlook.Application Set oNs = oOutlook.GetNamespace("MAPI")
STR_OWNER = "Thomas"
Set objOwner = oNs.CreateRecipient(STR_OWNER) objOwner.Resolve
If objOwner.Resolved Then Set FolderCal = oNs.GetSharedDefaultFolder(objOwner, olFolderCalendar) End If
Function sql_date_O(strdate As String) As String Dim dd As String Dim mm As String Dim yy As String Dim str_time As String If InStr(1, strdate, ":") > 0 Then str_time = Right(strdate, 8) strdate = Left(strdate, 10)
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
