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: 185
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: 996
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: 185
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: 996
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: 185
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
Freshman
 
Join Date: Aug 2014
Location: London
Posts: 43
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: 185
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: 996
Default

Could you give us your reviewed code to see if there's nothing else bugging ?
__________________
MPi²
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
 
-->