Import meeting requests 2010
Import meeting requests 2010
Import meeting requests 2010
Import meeting requests 2010
Import meeting requests 2010
Import meeting requests 2010 Import meeting requests 2010 Import meeting requests 2010 Import meeting requests 2010 Import meeting requests 2010 Import meeting requests 2010 Import meeting requests 2010 Import meeting requests 2010
Import meeting requests 2010 Import meeting requests 2010
Import meeting requests 2010
Go Back  Xtreme Visual Basic Talk > > > > Import meeting requests 2010


Reply
 
Thread Tools Display Modes
  #1  
Old 06-22-2017, 06:51 AM
spacey123 spacey123 is offline
Centurion
 
Join Date: Dec 2003
Location: UK
Posts: 187
Default Import meeting requests 2010


Hi all.

I have a spreadsheet that works great in Excel 2003, and with a little changing Outlook 2010, but I can't get it to work in Excel 2010.

It scans the calendar for meeting requests within an entered date range, with a keyword optional.

It works down to this line:
Code:
Set objAttendees = folit.Recipients
and comes up with the error:
Run-time error '287':
Application-defined or object-defined error.

I can see one of two things that may be the cause:
Outlook 2010 has changed the syntax and I should be looking for another object - for the life in me I can't see it when debugging this...
Someone said this may be restricted by security settings that we can't change.

Hopefully it's the first cause I'm thinking off...can anyone shed any light?

Cheers.

Code:
Sub search_all() Sheets("main output").Select start_date = Range("start_date").Value end_date = Range("end_date").Value If start_date = "" Or end_date = "" Then MsgBox "You must put a date range in. Ending." End End If Rows("10:65535").Delete Dim NS As NameSpace Set NS = GetNamespace("MAPI") Set myOlApp = CreateObject("Outlook.Application") Dim IbFol As MAPIFolder Dim item As Object Dim i As Integer Dim folit As Object Set objApp = CreateObject("Outlook.Application") Set objNS = objApp.GetNamespace("MAPI") Set objDummy = objApp.CreateItem(olMailItem) If Range("all_shared_mailbox").Value <> "" Then strName = Range("all_shared_mailbox").Value Set objRecip = objDummy.Recipients.Add(strName) On Error Resume Next Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar) If Err.Number <> 0 Then MsgBox "Invalid shared mailbox entered. Ending." End End If On Error GoTo 0 Else Set objFolder = NS.GetDefaultFolder(olFolderCalendar) End If roguey = 10 acc_rogue = 12 dec_rogue = 12 tent_rogue = 12 none_rogue = 12 For Each folit In objFolder.Items Dim dtStart As Date Dim dtEnd As Date Dim strSubject As String dtEnd = folit.End dtStart = folit.Start strSubject = folit.Subject done_it = 0 If (UCase(strSubject) Like "*" & UCase(Range("keyword").Value) & "*") And _ (dtStart >= start_date) And (dtEnd <= end_date) Then done_it = 1 folit.Display Dim objAttendees As Outlook.Recipients Dim objAttendeeReq As String Dim objAttendeeOpt As String Dim objOrganizer As String Dim strLocation As String Dim strNotes As String Dim strMeetStatus As String Dim strCopyData As String Dim strCount As String 'On Error Resume Next Set objApp = CreateObject("Outlook.Application") Set objAttendees = folit.Recipients ' Is it an appointment If folit.Class <> 26 Then MsgBox "This code only works with meetings." GoTo EndClean End If strLocation = folit.Location strNotes = folit.Body objOrganizer = folit.Organizer objAttendeeReq = "" objAttendeeOpt = "" 'Get The Attendee List For x = 1 To objAttendees.Count strMeetStatus = "" starting_row = roguey + 2 Range("a" & roguey & ":k" & roguey).Font.Bold = True Range("a" & roguey).Value = strSubject Range("h" & roguey).Value = "From:" Range("i" & roguey).Value = dtStart Range("j" & roguey).Value = "To:" Range("k" & roguey).Value = dtEnd Range("a" & roguey & ":k" & roguey + 1).Interior.Color = 5287936 Range("a" & roguey + 1).Value = "Accepted" Range("a" & roguey + 1).Font.Bold = True Range("d" & roguey + 1).Value = "Declined" Range("d" & roguey + 1).Font.Bold = True Range("g" & roguey + 1).Value = "Tentative" Range("g" & roguey + 1).Font.Bold = True Range("j" & roguey + 1).Value = "No Response (or Organiser)" Range("j" & roguey + 1).Font.Bold = True Select Case objAttendees(x).MeetingResponseStatus Case 0 strMeetStatus = "No Response (or Organizer)" ino = ino + 1 Range("j" & none_rogue) = objAttendees(x).Name If objOrganizer = objAttendees(x).Name Then Range("j" & none_rogue).AddComment 'Range("J12").Comment.Visible = False Range("j" & none_rogue).Comment.Text Text:="Organiser" 'Range("j" & none_rogue & ":k" & none_rogue).Interior.Color = 49407 End If none_rogue = none_rogue + 1 Case 1 strMeetStatus = "Organizer" ino = ino + 1 Case 2 strMeetStatus = "Tentative" it = it + 1 Range("g" & tent_rogue) = objAttendees(x).Name tent_rogue = tent_rogue + 1 Case 3 strMeetStatus = "Accepted" ia = ia + 1 Range("a" & acc_rogue) = objAttendees(x).Name acc_rogue = acc_rogue + 1 Case 4 strMeetStatus = "Declined" ide = ide + 1 Range("d" & dec_rogue) = objAttendees(x).Name dec_rogue = dec_rogue + 1 End Select If objAttendees(x).Type = olRequired Then objAttendeeReq = objAttendeeReq & objAttendees(x).Name & vbTab & strMeetStatus & vbCrLf ElseIf objAttendees(x).Type = olRequired Then objAttendeeTent = objAttendeeTent & objAttendees(x).Name & vbTab & strMeetStatus & vbCrLf Else objAttendeeOpt = objAttendeeOpt & objAttendees(x).Name & vbTab & strMeetStatus & vbCrLf End If Next ' strCopyData = "Organizer: " & objOrganizer & vbCrLf & "Subject: " & strSubject & vbCrLf & _ ' "Location: " & strLocation & vbCrLf & "Start: " & dtStart & vbCrLf & "End: " & dtEnd & _ ' vbCrLf & vbCrLf & "Required: " & vbCrLf & objAttendeeReq & vbCrLf & "Optional: " & _ ' vbCrLf & objAttendeeOpt & vbCrLf & "NOTES " & vbCrLf & strNotes ' strCount = "Accepted: " & ia & vbCrLf & _ ' "Declined: " & ide & vbCrLf & "Tentative: " & it & vbCrLf & "No response: " & ino folit.Close 1 thelastrow = Application.Max(dec_rogue, acc_rogue, tent_rogue, none_rogue) + 2 Range("a" & starting_row & ":k" & thelastrow - 3).Interior.Color = 14994616 End If If done_it = 1 Then roguey = thelastrow dec_rogue = roguey + 2 acc_rogue = roguey + 2 tent_rogue = roguey + 2 none_rogue = roguey + 2 End If EndClean: Set objAttendees = Nothing Set objApp = Nothing Next Set objRecip = Nothing Set objDummy = Nothing Set objNS = Nothing MsgBox "Done." End Sub
Reply With Quote
  #2  
Old 07-11-2017, 07:12 AM
MPiImport meeting requests 2010 MPi is offline
Senior Contributor

Forum Leader
* Expert *
 
Join Date: Dec 2001
Location: Quebec
Posts: 998
Default

Hi,

A little late... I was on vacation...
Since you use CreateObject, you possibly didn't check any reference to Outlook... right?
Change this line to see if it's better
Code:
Dim objAttendees As Outlook.Recipients
for
Code:
Dim objAttendees As Object
__________________
MPi²
Reply With Quote
  #3  
Old 07-17-2017, 01:46 AM
spacey123 spacey123 is offline
Centurion
 
Join Date: Dec 2003
Location: UK
Posts: 187
Default

Dang...got a little excited when I got the notification last week and tried it when returning to work.

Still the same error I'm afraid

In tools>references I have one set up to Outlook 14.0 library (if that's what you asked).

The part of the code that sets up Outlook etc is recycled code that I keep using and modify until it works, so I'm not too au fait with setting up this section of the code..but as it works on Excel 2003 then it works to some extent...just not on 2010...
Reply With Quote
  #4  
Old 07-17-2017, 12:01 PM
MPiImport meeting requests 2010 MPi is offline
Senior Contributor

Forum Leader
* Expert *
 
Join Date: Dec 2001
Location: Quebec
Posts: 998
Default

Here we have Office 2016 and the code is working fine with the reference.
If I remove the reference, I have to change the type to Object instead of Outlook.Recipients

Also, at the beginning of your code, you don't need these lines
' Dim NS As Namespace
' Set NS = GetNamespace("MAPI")
' Set myOlApp = CreateObject("Outlook.Application")
' Dim IbFol As MAPIFolder
' Dim item As Object
' Dim i As Integer

You may try a test...
Remove the reference and change these lines

add
Code:
Dim objFolder As Object
Change this one
Code:
Set objDummy = objApp.CreateItem(0) '(olMailItem)
and this one
Code:
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, 9)
PS: I don't receive notifications when people reply on my messages even if I accept them... (?)
__________________
MPi²
Reply With Quote
  #5  
Old 07-18-2017, 12:57 AM
spacey123 spacey123 is offline
Centurion
 
Join Date: Dec 2003
Location: UK
Posts: 187
Default

Hi.

Have made the changes you suggested, and removed the reference to Outlook. Revised code at the bottom.

Run the code and I get:
Compile Error
User-defined type not defined

on line:
Code:
Dim objAttendees As Outlook.Recipients

I'm guessing this is because I took out the reference to Outlook. If correct...what would I change this to?

Cheers.



Code:
Sub search_all() Sheets("main output").Select start_date = Range("start_date").Value end_date = Range("end_date").Value If start_date = "" Or end_date = "" Then MsgBox "You must put a date range in. Ending." End End If Rows("10:65535").Delete Dim objFolder As Object Dim folit As Object Set objApp = CreateObject("Outlook.Application") Set objNS = objApp.GetNamespace("MAPI") Set objDummy = objApp.CreateItem(0) '(olMailItem) If Range("all_shared_mailbox").Value <> "" Then strName = Range("all_shared_mailbox").Value Set objRecip = objDummy.Recipients.Add(strName) On Error Resume Next Set objFolder = objNS.GetSharedDefaultFolder(objRecip, 9) If Err.Number <> 0 Then MsgBox "Invalid shared mailbox entered. Ending." End End If On Error GoTo 0 Else Set objFolder = NS.GetDefaultFolder(olFolderCalendar) End If roguey = 10 acc_rogue = 12 dec_rogue = 12 tent_rogue = 12 none_rogue = 12 For Each folit In objFolder.Items Dim dtStart As Date Dim dtEnd As Date Dim strSubject As String dtEnd = folit.End dtStart = folit.Start strSubject = folit.Subject done_it = 0 If (UCase(strSubject) Like "*" & UCase(Range("keyword").Value) & "*") And _ (dtStart >= start_date) And (dtEnd <= end_date) Then done_it = 1 folit.Display Dim objAttendees As Outlook.Recipients Dim objAttendeeReq As String Dim objAttendeeOpt As String Dim objOrganizer As String Dim strLocation As String Dim strNotes As String Dim strMeetStatus As String Dim strCopyData As String Dim strCount As String Set objApp = CreateObject("Outlook.Application") Set objAttendees = folit.Recipients ' Is it an appointment If folit.Class <> 26 Then MsgBox "This code only works with meetings." GoTo EndClean End If strLocation = folit.Location strNotes = folit.Body objOrganizer = folit.Organizer objAttendeeReq = "" objAttendeeOpt = "" 'Get The Attendee List For x = 1 To objAttendees.Count strMeetStatus = "" starting_row = roguey + 2 Range("a" & roguey & ":k" & roguey).Font.Bold = True Range("a" & roguey).Value = strSubject Range("h" & roguey).Value = "From:" Range("i" & roguey).Value = dtStart Range("j" & roguey).Value = "To:" Range("k" & roguey).Value = dtEnd Range("a" & roguey & ":k" & roguey + 1).Interior.Color = 5287936 Range("a" & roguey + 1).Value = "Accepted" Range("a" & roguey + 1).Font.Bold = True Range("d" & roguey + 1).Value = "Declined" Range("d" & roguey + 1).Font.Bold = True Range("g" & roguey + 1).Value = "Tentative" Range("g" & roguey + 1).Font.Bold = True Range("j" & roguey + 1).Value = "No Response (or Organiser)" Range("j" & roguey + 1).Font.Bold = True Select Case objAttendees(x).MeetingResponseStatus Case 0 strMeetStatus = "No Response (or Organizer)" ino = ino + 1 Range("j" & none_rogue) = objAttendees(x).Name If objOrganizer = objAttendees(x).Name Then Range("j" & none_rogue).AddComment Range("j" & none_rogue).Comment.Text Text:="Organiser" End If none_rogue = none_rogue + 1 Case 1 strMeetStatus = "Organizer" ino = ino + 1 Case 2 strMeetStatus = "Tentative" it = it + 1 Range("g" & tent_rogue) = objAttendees(x).Name tent_rogue = tent_rogue + 1 Case 3 strMeetStatus = "Accepted" ia = ia + 1 Range("a" & acc_rogue) = objAttendees(x).Name acc_rogue = acc_rogue + 1 Case 4 strMeetStatus = "Declined" ide = ide + 1 Range("d" & dec_rogue) = objAttendees(x).Name dec_rogue = dec_rogue + 1 End Select If objAttendees(x).Type = olRequired Then objAttendeeReq = objAttendeeReq & objAttendees(x).Name & vbTab & strMeetStatus & vbCrLf ElseIf objAttendees(x).Type = olRequired Then objAttendeeTent = objAttendeeTent & objAttendees(x).Name & vbTab & strMeetStatus & vbCrLf Else objAttendeeOpt = objAttendeeOpt & objAttendees(x).Name & vbTab & strMeetStatus & vbCrLf End If Next folit.Close 1 thelastrow = Application.Max(dec_rogue, acc_rogue, tent_rogue, none_rogue) + 2 Range("a" & starting_row & ":k" & thelastrow - 3).Interior.Color = 14994616 End If If done_it = 1 Then roguey = thelastrow dec_rogue = roguey + 2 acc_rogue = roguey + 2 tent_rogue = roguey + 2 none_rogue = roguey + 2 End If EndClean: Set objAttendees = Nothing Set objApp = Nothing Next Set objRecip = Nothing Set objDummy = Nothing Set objNS = Nothing MsgBox "Done." End Sub
Reply With Quote
  #6  
Old 07-18-2017, 05:38 AM
Daigon Ali Daigon Ali is offline
Regular
 
Join Date: Aug 2014
Location: London
Posts: 51
Default

Hi,

I needed to change 2 lines in your latest code for it to work.

Change
Code:
Dim objAttendees As Outlook.Recipients
To
Code:
Dim objAttendees As Object
Change
Code:
Else
    Set objFolder = NS.GetDefaultFolder(olFolderCalendar)
End If
To
Code:
Else
    Set objFolder = objNS.GetDefaultFolder(9)
End If
Reply With Quote
  #7  
Old 07-19-2017, 01:40 AM
spacey123 spacey123 is offline
Centurion
 
Join Date: Dec 2003
Location: UK
Posts: 187
Default

Thanks...I made the changes but still getting an error...as it works for others and not for me am going to have to assume it's something at my end stopping this from working.

For info the error is:
Run-time error '287':
Application-defined or object-defined error.
(on the line Set objAttendees = folit.Recipients)

One thing that's always puzzled me is that I went through the Locals window trying to see if I could find anyone's name that were on the meeting but to no joy.
If I look at folit>recipients it has a value of <> with the type of Recipients. The <> has always puzzled me as I would have expected to see a value in there.

May be this isn't doable under our systems on Windows 7 / Office 2010 environments...
Reply With Quote
  #8  
Old 07-19-2017, 06:30 AM
MPiImport meeting requests 2010 MPi is offline
Senior Contributor

Forum Leader
* Expert *
 
Join Date: Dec 2001
Location: Quebec
Posts: 998
Default

Could you give us your reviewed code to see if there's nothing else bugging ?
__________________
MPi²
Reply With Quote
  #9  
Old 07-24-2017, 12:46 AM
spacey123 spacey123 is offline
Centurion
 
Join Date: Dec 2003
Location: UK
Posts: 187
Default

Hi.

Busy week!

Below is the code as it stands at the moment.

Cheers.


Code:
Sub search_all() Sheets("main output").Select start_date = Range("start_date").Value end_date = Range("end_date").Value If start_date = "" Or end_date = "" Then MsgBox "You must put a date range in. Ending." End End If Rows("10:65535").Delete Dim objFolder As Object Dim folit As Object Set objApp = CreateObject("Outlook.Application") Set objNS = objApp.GetNamespace("MAPI") Set objDummy = objApp.CreateItem(0) '(olMailItem) If Range("all_shared_mailbox").Value <> "" Then strName = Range("all_shared_mailbox").Value Set objRecip = objDummy.Recipients.Add(strName) On Error Resume Next Set objFolder = objNS.GetSharedDefaultFolder(objRecip, 9) If Err.Number <> 0 Then MsgBox "Invalid shared mailbox entered. Ending." End End If On Error GoTo 0 Else Set objFolder = objNS.GetDefaultFolder(9) End If roguey = 10 acc_rogue = 12 dec_rogue = 12 tent_rogue = 12 none_rogue = 12 For Each folit In objFolder.Items Dim dtStart As Date Dim dtEnd As Date Dim strSubject As String dtEnd = folit.End dtStart = folit.Start strSubject = folit.Subject done_it = 0 If (UCase(strSubject) Like "*" & UCase(Range("keyword").Value) & "*") And _ (dtStart >= start_date) And (dtEnd <= end_date) Then done_it = 1 folit.Display Dim objAttendees As Object Dim objAttendeeReq As String Dim objAttendeeOpt As String Dim objOrganizer As String Dim strLocation As String Dim strNotes As String Dim strMeetStatus As String Dim strCopyData As String Dim strCount As String Set objApp = CreateObject("Outlook.Application") Set objAttendees = folit.Recipients ' Is it an appointment If folit.Class <> 26 Then MsgBox "This code only works with meetings." GoTo EndClean End If strLocation = folit.Location strNotes = folit.Body objOrganizer = folit.Organizer objAttendeeReq = "" objAttendeeOpt = "" 'Get The Attendee List For x = 1 To objAttendees.Count strMeetStatus = "" starting_row = roguey + 2 Range("a" & roguey & ":k" & roguey).Font.Bold = True Range("a" & roguey).Value = strSubject Range("h" & roguey).Value = "From:" Range("i" & roguey).Value = dtStart Range("j" & roguey).Value = "To:" Range("k" & roguey).Value = dtEnd Range("a" & roguey & ":k" & roguey + 1).Interior.Color = 5287936 Range("a" & roguey + 1).Value = "Accepted" Range("a" & roguey + 1).Font.Bold = True Range("d" & roguey + 1).Value = "Declined" Range("d" & roguey + 1).Font.Bold = True Range("g" & roguey + 1).Value = "Tentative" Range("g" & roguey + 1).Font.Bold = True Range("j" & roguey + 1).Value = "No Response (or Organiser)" Range("j" & roguey + 1).Font.Bold = True Select Case objAttendees(x).MeetingResponseStatus Case 0 strMeetStatus = "No Response (or Organizer)" ino = ino + 1 Range("j" & none_rogue) = objAttendees(x).Name If objOrganizer = objAttendees(x).Name Then Range("j" & none_rogue).AddComment Range("j" & none_rogue).Comment.Text Text:="Organiser" End If none_rogue = none_rogue + 1 Case 1 strMeetStatus = "Organizer" ino = ino + 1 Case 2 strMeetStatus = "Tentative" it = it + 1 Range("g" & tent_rogue) = objAttendees(x).Name tent_rogue = tent_rogue + 1 Case 3 strMeetStatus = "Accepted" ia = ia + 1 Range("a" & acc_rogue) = objAttendees(x).Name acc_rogue = acc_rogue + 1 Case 4 strMeetStatus = "Declined" ide = ide + 1 Range("d" & dec_rogue) = objAttendees(x).Name dec_rogue = dec_rogue + 1 End Select If objAttendees(x).Type = olRequired Then objAttendeeReq = objAttendeeReq & objAttendees(x).Name & vbTab & strMeetStatus & vbCrLf ElseIf objAttendees(x).Type = olRequired Then objAttendeeTent = objAttendeeTent & objAttendees(x).Name & vbTab & strMeetStatus & vbCrLf Else objAttendeeOpt = objAttendeeOpt & objAttendees(x).Name & vbTab & strMeetStatus & vbCrLf End If Next folit.Close 1 thelastrow = Application.Max(dec_rogue, acc_rogue, tent_rogue, none_rogue) + 2 Range("a" & starting_row & ":k" & thelastrow - 3).Interior.Color = 14994616 End If If done_it = 1 Then roguey = thelastrow dec_rogue = roguey + 2 acc_rogue = roguey + 2 tent_rogue = roguey + 2 none_rogue = roguey + 2 End If EndClean: Set objAttendees = Nothing Set objApp = Nothing Next Set objRecip = Nothing Set objDummy = Nothing Set objNS = Nothing MsgBox "Done." End Sub
Reply With Quote
  #10  
Old 07-24-2017, 07:46 AM
MPiImport meeting requests 2010 MPi is offline
Senior Contributor

Forum Leader
* Expert *
 
Join Date: Dec 2001
Location: Quebec
Posts: 998
Default

Try it like that.
Don't forget to Dim ALL your variables and preferably at the beginning of the Sub
To make sure you Dim everything, put Option Explicit at the top of the page. You may select the Tools menu > Options and in the first tab, uncheck the first item so you don't always get an error message and check the second one to force the variable declaration.

Code:
Sub search_all()
    Dim objApp As Object, objNS As Object, objDummy As Object
    Dim objFolder As Object, objRecip As Object, objAttendeeTent As Object
    Dim folit As Object
    Dim objAttendees As Object
    Dim objAttendeeReq As String
    Dim objAttendeeOpt As String
    Dim objOrganizer As String
    Dim strLocation As String
    Dim strNotes As String
    Dim strMeetStatus As String
    Dim strCopyData As String
    Dim strCount  As String
    Dim dtStart As Date
    Dim dtEnd As Date
    Dim strSubject As String
    Dim strName As String
    Dim start_date As Date, end_date As Date
    Dim roguey, acc_rogue, dec_rogue, tent_rogue, none_rogue
    Dim done_it
    Dim x As Long, starting_row As Long, thelastrow As Long
    Dim ino As Long, it As Long, ia As Long, ide As Long
    
    Sheets("main output").Select
    start_date = Range("start_date").Value
    end_date = Range("end_date").Value
    If start_date = 0 Or end_date = 0 Then
        MsgBox "You must put a date range in.  Ending."
        End
    End If
    Rows("10:65535").Delete
    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    Set objDummy = objApp.CreateItem(0) '(olMailItem)
    If Range("all_shared_mailbox").Value <> "" Then
        strName = Range("all_shared_mailbox").Value
        Set objRecip = objDummy.Recipients.Add(strName)
        On Error Resume Next
            Set objFolder = objNS.GetSharedDefaultFolder(objRecip, 9)
        If Err.Number <> 0 Then
            MsgBox "Invalid shared mailbox entered.  Ending."
            End
        End If
        On Error GoTo 0
    Else
        Set objFolder = objNS.GetDefaultFolder(9)
    End If
    
    roguey = 10
    acc_rogue = 12
    dec_rogue = 12
    tent_rogue = 12
    none_rogue = 12
    For Each folit In objFolder.Items
        dtEnd = folit.End
        dtStart = folit.Start
        strSubject = folit.Subject
        done_it = 0
        If (UCase(strSubject) Like "*" & UCase(Range("keyword").Value) & "*") And _
            (dtStart >= start_date) And (dtEnd <= end_date) Then
            done_it = 1
            folit.Display
            Set objApp = CreateObject("Outlook.Application")
            Set objAttendees = folit.Recipients
            ' Is it an appointment
            If folit.Class <> 26 Then
                MsgBox "This code only works with meetings."
                GoTo EndClean
            End If
            strLocation = folit.Location
            strNotes = folit.Body
            objOrganizer = folit.Organizer
            objAttendeeReq = ""
            objAttendeeOpt = ""
        'Get The Attendee List
            For x = 1 To objAttendees.Count
                strMeetStatus = ""
                starting_row = roguey + 2
                Range("a" & roguey & ":k" & roguey).Font.Bold = True
                Range("a" & roguey).Value = strSubject
                Range("h" & roguey).Value = "From:"
                Range("i" & roguey).Value = dtStart
                Range("j" & roguey).Value = "To:"
                Range("k" & roguey).Value = dtEnd
                Range("a" & roguey & ":k" & roguey + 1).Interior.Color = 5287936
                Range("a" & roguey + 1).Value = "Accepted"
                Range("a" & roguey + 1).Font.Bold = True
                Range("d" & roguey + 1).Value = "Declined"
                Range("d" & roguey + 1).Font.Bold = True
                Range("g" & roguey + 1).Value = "Tentative"
                Range("g" & roguey + 1).Font.Bold = True
                Range("j" & roguey + 1).Value = "No Response (or Organiser)"
                Range("j" & roguey + 1).Font.Bold = True
                Select Case objAttendees(x).MeetingResponseStatus
                    Case 0
                        strMeetStatus = "No Response (or Organizer)"
                        ino = ino + 1
                        Range("j" & none_rogue) = objAttendees(x).Name
                        If objOrganizer = objAttendees(x).Name Then
                            Range("j" & none_rogue).AddComment
                            Range("j" & none_rogue).Comment.Text Text:="Organiser"
                        End If
                        none_rogue = none_rogue + 1
                    Case 1
                        strMeetStatus = "Organizer"
                        ino = ino + 1
                    Case 2
                        strMeetStatus = "Tentative"
                        it = it + 1
                        Range("g" & tent_rogue) = objAttendees(x).Name
                        tent_rogue = tent_rogue + 1
                    Case 3
                        strMeetStatus = "Accepted"
                        ia = ia + 1
                        Range("a" & acc_rogue) = objAttendees(x).Name
                        acc_rogue = acc_rogue + 1
                    Case 4
                        strMeetStatus = "Declined"
                        ide = ide + 1
                        Range("d" & dec_rogue) = objAttendees(x).Name
                        dec_rogue = dec_rogue + 1
                End Select
                
                If objAttendees(x).Type = 1 Then    ' olRequired Then
                    objAttendeeReq = objAttendeeReq & objAttendees(x).Name & vbTab & strMeetStatus & vbCrLf
                ElseIf objAttendees(x).Type = olRequired Then
                    objAttendeeTent = objAttendeeTent & objAttendees(x).Name & vbTab & strMeetStatus & vbCrLf
                Else
                    objAttendeeOpt = objAttendeeOpt & objAttendees(x).Name & vbTab & strMeetStatus & vbCrLf
                End If
            Next
            folit.Close 1
        thelastrow = Application.Max(dec_rogue, acc_rogue, tent_rogue, none_rogue) + 2
    
        Range("a" & starting_row & ":k" & thelastrow - 3).Interior.Color = 14994616
        End If
            
        If done_it = 1 Then
            roguey = thelastrow
            dec_rogue = roguey + 2
            acc_rogue = roguey + 2
            tent_rogue = roguey + 2
            none_rogue = roguey + 2
        End If
        
EndClean:
            Set objAttendees = Nothing
            Set objApp = Nothing
            
    Next
    Set objRecip = Nothing
    Set objDummy = Nothing
    Set objNS = Nothing
    MsgBox "Done."
End Sub
__________________
MPi²
Reply With Quote
  #11  
Old 07-25-2017, 10:11 AM
Daigon Ali Daigon Ali is offline
Regular
 
Join Date: Aug 2014
Location: London
Posts: 51
Question

Is outlook open when you run the code?
Reply With Quote
  #12  
Old 07-27-2017, 12:24 AM
spacey123 spacey123 is offline
Centurion
 
Join Date: Dec 2003
Location: UK
Posts: 187
Default

Quote:
Originally Posted by Daigon Ali View Post
Is outlook open when you run the code?
Yes
Reply With Quote
  #13  
Old 07-27-2017, 03:04 AM
Daigon Ali Daigon Ali is offline
Regular
 
Join Date: Aug 2014
Location: London
Posts: 51
Default

Perhaps an Outlook security issue?
The only way I can replicate this is to change the Trust Center settings to deny programmatic access. It then produces the 287 error on the line you stated.
Reply With Quote
Reply

Tags
set, dim, error, date, dtend, start_date, dtstart, object, objfolder, folit, end_date, entered, outlook, strsubject, msgbox, excel, requests, range, meeting, rangeend_date.value, objdummy, objapp, objapp.getnamespacemapi, objns, ibfol


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off

Forum Jump

Advertisement:





Free Publications
The ASP.NET 2.0 Anthology
101 Essential Tips, Tricks & Hacks - Free 156 Page Preview. Learn the most practical features and best approaches for ASP.NET.
subscribe
Programmers Heaven C# School Book -Free 338 Page eBook
The Programmers Heaven C# School book covers the .NET framework and the C# language.
subscribe
Build Your Own ASP.NET 3.5 Web Site Using C# & VB, 3rd Edition - Free 219 Page Preview!
This comprehensive step-by-step guide will help get your database-driven ASP.NET web site up and running in no time..
subscribe
Import meeting requests 2010
Import meeting requests 2010
Import meeting requests 2010 Import meeting requests 2010
Import meeting requests 2010
Import meeting requests 2010
Import meeting requests 2010 Import meeting requests 2010 Import meeting requests 2010 Import meeting requests 2010 Import meeting requests 2010 Import meeting requests 2010 Import meeting requests 2010
Import meeting requests 2010
Import meeting requests 2010
 
Import meeting requests 2010
Import meeting requests 2010
 
-->