UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
> Error Saying Object Does Not Support This Object Or Method, Office 2013    
 
   
wornout
post Nov 7 2019, 06:16 PM
Post#1



Posts: 1,329
Joined: 17-November 13
From: Orewa New Zealand


I am trying to import my appointments from the outlook Teaching calendar into excel but I want the recurrences as well. the only code I could find was the below

CODE
  oAppointments.Sort "[Start]"
    oAppointments.IncludeRecurrences = True
      tStart = Format(Date, "01/10/yyyy")
    tEnd = Format(Date, "31/12/yyyy")
    sfilter = "[Start] >= '" & tStart & "' And [End] < '" & tEnd & "'"
    Set oFilterAppointments = oAppointments.Items.Restrict(sfilter)
    Debug.Print oFilterAppointments.Count & " appointments found."
   Debug.Print sfilter

But I get an error that excel saying Object does not support this object or method and highlights the oAppointments.Sort "[Start]"
the full code is
CODE
Sub Importappointments()
    Dim oOutlook              As Object
    Dim oNS                   As Object
    Dim oAppointments         As Object
    Dim oppAppointments   As Object
    Dim oFilterAppointments   As Object
    Dim oAppointmentItem      As Object
    Dim bOutlookOpened        As Boolean
    Dim sfilter               As String
    Dim displayText As String
    Dim startDate As Date
    Dim tStart As Date, tEnd As Date
Dim getOutlookAppointments() As String
  
    Set oOutlook = GetObject(, "Outlook.Application")    'Bind to existing instance of Outlook
    If Err.Number <> 0 Then    'Could not get instance of Outlook, so create a new one
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
        bOutlookOpened = False    'Outlook was not already running, we had to start it
    Else
        bOutlookOpened = True    'Outlook was already running
    End If

  

    
    
    Set oNS = oOutlook.GetNamespace("MAPI")
    
    Set oppAppointments = oNS.GetDefaultFolder(9)
    
    Set oAppointments = oppAppointments.Folders("Teaching")

    oAppointments.Sort "[Start]"
    oAppointments.IncludeRecurrences = True
      tStart = Format(Date, "01/10/yyyy")
    tEnd = Format(Date, "31/12/yyyy")
    sfilter = "[Start] >= '" & tStart & "' And [End] < '" & tEnd & "'"
    Set oFilterAppointments = oAppointments.Items.Restrict(sfilter)
    Debug.Print oFilterAppointments.Count & " appointments found."
   Debug.Print sfilter
    'Iterate through each appt in our calendar

  


Set sht = ActiveWorkbook.Worksheets("Sheet2")

lngRow = 3

For Each olApptoAppointmentItem In oFilterAppointments
  With olApptoAppointmentItem
    DoEvents
      sht.Cells(lngRow, 2) = .Subject
      sht.Cells(lngRow, 3) = .Start
      sht.Cells(lngRow, 4) = .End
      sht.Cells(lngRow, 5) = .Categories
      sht.Cells(lngRow, 6) = .Location
    sht.Cells(lngRow, 7) = .Start
      sht.Cells(lngRow, 8) = .End

        lngRow = lngRow + 1
  End With
Next
  With Range("G3:H50")
    .Value = TimeValue(.Value)
    .NumberFormat = "h:mm:ss AM/PM"
End With
  
ActiveWorkbook.Worksheets("Sheet2").ListObjects("Table1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet2").ListObjects("Table1").Sort.SortFields.Add2 _
        Key:=Range("Table1[Day]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        CustomOrder:="Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday", _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet2").ListObjects("Table1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.RefreshAll
    If bOutlookOpened = False Then    'Since we started Outlook, we should close it now that we're done
        oOutlook.Quit 'There seems to be a delay in this action taking place, but does eventually take place
    End If



    outlookDates = False
End Sub
Go to the top of the page
 

Posts in this topic



Custom Search


RSSSearch   Top   Lo-Fi    26th January 2020 - 09:13 AM