Hi all,
I am using Office 365 Pro Plus build 1912 (but it also ran on build 1902 or 1904 before I upgraded recently).
My macro is written to interrogate my own, and shared calendars with me from outlook - and bring the appointments into Excel in a list.
It works beautifully on my own machine - I can grab data from each calendar in turn. However, when I pass my excel file to a colleague for him (actually tried 2 different people) to run the macro on his machine (same build config etc.) - it runs into problems.
The code appears to execute as expected (in that it takes some time to grab this years and last years data), and then completes once its done, without displaying any of the data. We are currently remote, so I've not tried stepping through the code on their machines to see what its doing yet - but on the face of it - it appears to be running correctly - just not fetching the Outlook Calendar data.
I have set the Outlook Object reference (16.0) in the developer/Tools/References on their machines accordingly.
Can I ask, Are there any other settings that I need to have done on their machines in order for this to function ?
I've been using macros on my machines for a long time - so wondered if I'd set something some time ago that I'd forgotten about recently.... I'll paste a section of my code here, just for reference.
I am using Office 365 Pro Plus build 1912 (but it also ran on build 1902 or 1904 before I upgraded recently).
My macro is written to interrogate my own, and shared calendars with me from outlook - and bring the appointments into Excel in a list.
It works beautifully on my own machine - I can grab data from each calendar in turn. However, when I pass my excel file to a colleague for him (actually tried 2 different people) to run the macro on his machine (same build config etc.) - it runs into problems.
The code appears to execute as expected (in that it takes some time to grab this years and last years data), and then completes once its done, without displaying any of the data. We are currently remote, so I've not tried stepping through the code on their machines to see what its doing yet - but on the face of it - it appears to be running correctly - just not fetching the Outlook Calendar data.
I have set the Outlook Object reference (16.0) in the developer/Tools/References on their machines accordingly.
Can I ask, Are there any other settings that I need to have done on their machines in order for this to function ?
I've been using macros on my machines for a long time - so wondered if I'd set something some time ago that I'd forgotten about recently.... I'll paste a section of my code here, just for reference.
VBA Code:
Option Explicit
Public R As Long
Public SelectedCalendar As String
' ********************************************************************************
' * Interrogate Outlook calendars for all external meetings & populate
' * Excel database with attendees coming down the columns for each appt.
' **********************************************************************************
Sub outlook_calendaritemsexport()
Dim C As Long, i As Long, lrow As Long
Dim appt_id As Long, append_row As Long
Dim data_array() As Variant, start_time As Variant
Dim myfol As Outlook.Folder
Dim ons As Outlook.Namespace
Dim o As Outlook.Application
Dim myapt As Outlook.AppointmentItem
Dim myrpnt As Outlook.Recipient
Dim oEU As Object
Set o = New Outlook.Application
Set ons = o.GetNamespace("MAPI")
start_time = Now()
Sheets("Data").Activate
'Show UserForm here. UserForm is a simple box with names of shared calendars, which gets stored into "SelectedCalendar" upon selection. R is also set to 5 (start row on my sheet), or last row after current data
UserForm1.Show
'Setup 'Subroutine to Setup column widths / colors etc
append_row = R 'use this to know where to append the new data onto screen for an appended search.. R comes from UserForm.
Dim myRecipient As Outlook.Recipient
'selected in the userform ComboBox list
If SelectedCalendar = "Select Calendar" Then 'nobody selected, so operate on your own calendar
Set myfol = ons.GetDefaultFolder(olFolderCalendar) 'Set this to work on own folder
Else
Set myRecipient = ons.CreateRecipient(SelectedCalendar)
myRecipient.Resolve
If myRecipient.Resolved Then
Set myfol = ons.GetSharedDefaultFolder(myRecipient, olFolderCalendar)
Else
MsgBox ("Calendar Issue, Program Halted")
End 'end if calendar not resolved
End If
End If
Range("A4:N4").Value = Array("DATE", "CUSTOMER", "SUBJECT", "LOCATION", "CUSTOMER TYPE or DISTRIBUTOR MEETING", "FACE To FACE / TEAMS", "DISTRIBUTOR Or ALONE", "DISTRIBUTOR VISIT TYPE", "CUSTOMER ATTENDEES", "DISTRIBUTOR ATTENDEES", "OUR ATTENDEES", "REQUIRED ATTENDEES", "CALENDAR OWNER", "MEET ID")
'check calendar has some items inside / is shared
On Error GoTo ErrorHandler
lrow = 0 'array row start)
ReDim Preserve data_array(1 To 14, lrow) '(be aware the array is transposed, as ReDim Preserve only works on last dimension)
'*** GET THIS DYNAMICALLY FROM LAST ROW OF DATA (comes from userform button) in case of New, or Appended data search *****
If R = 5 Then
appt_id = 1 'set first appointment ID number
Else
appt_id = Cells(R - 1, 14).Value + 1
End If
R = 0 ' now reset R as first row in array
For Each myapt In myfol.Items 'check each calendar Appointment) Then
'Year(Now()) Year(Now())-1 this year last year
If InStr(myapt.Start, Year(Now())) > 0 Or InStr(myapt.Start, (Year(Now())) - 1) > 0 Then ' if appt is this year/last year
data_array(1, R) = myapt.Start
data_array(3, R) = myapt.Subject
data_array(4, R) = myapt.Location
data_array(12, R) = LCase(myapt.RequiredAttendees)
data_array(13, R) = SelectedCalendar
data_array(14, R) = appt_id
appt_id = appt_id + 1 ' update appointment ID code
ReDim Preserve data_array(1 To 14, R + 1)
R = R + 1
End If 'End Appt year checking
Next 'Calendar Appointment
Set o = Nothing
Set ons = Nothing
Set myfol = Nothing
Set myapt = Nothing
Set myrpnt = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
'store data on screen
Range(Cells(append_row, 1), Cells(append_row + UBound(data_array, 2), 14)) = TransposeArray(data_array) 'function to transpose data back into rows due to RedimPreserve operating across only
MsgBox ("start : " & start_time & " finish : " & Now())
Erase data_array
End
ErrorHandler:
MsgBox ("Calendar Not Shared")
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End
End Sub
