Results 1 to 3 of 3

Thread: Original "start date" of postponed appointment

  1. #1
    VBAX Regular
    Mar 2019

    Thumbs up Original "start date" of postponed appointment


    Hopefully someone could help

    I use VBA code that runs through Microsoft Outlook Appointments, and for each appointment - prints a few details - to an Excel table.

    If I set the start date of an appointment on "01-April-2019", and then postpone that appointment to "12-April-2019", and then postpone that appointment to "15-April-2019" - I have 3 "Appointment Item" objects in my folder.
    I would like to print for each appointment in the folder - the "Start Date" that was set *originally*.
    For example: Print for the first appointment - the first original start date (01-April-2019), for the first postponed appointment - the first postponed start date (12-April-2019), and for the second postponed appointment - the second postponed start date (15-April-2019).

    However, when I run my code - the *last* "Start Date" is printed (15-April-2019, 15-April-2019, 15-April-2019), instead of the original (01-April-2019, 12-April-2019, 15-April-2019) .

    I read a lot about different types of "date" objects, but couldn't find the correct one.

    Could anyone help me?

    Thank you very much!

    Sub GetFromOutlook()
    'Early Binding: Tools > References > Microsoft Outlook xx.0 Object Library > OK
    Dim OutlookApp As Outlook.Application
    Dim OutlookNS As Namespace
    Dim Folder As MAPIFolder
    Dim oApp As Outlook.Application
    Dim oG As Outlook.Folder  'Method for IMAP, as used by Gmail.
    Dim oM As Outlook.MeetingItem
    Dim oAA As Outlook.AppointmentItem
    Dim oI As Outlook.RecurrencePattern
    Dim sMsg$, sAdd$
    Dim i As Long
    Dim j As Long
    Set OutlookApp = New Outlook.Application
    Set OutlookNS = OutlookApp.GetNamespace("MAPI")
    Set Folder = OutlookNS.GetDefaultFolder(olFolderInbox).Parent.Folders("CCB Meetings")
     Dim icon As String
      Set oApp = CreateObject("Outlook.Application")
      Set oG = OutlookNS.GetDefaultFolder(olFolderInbox).Parent.Folders("CCB Meetings")
      For i = 1 To oG.Items.Count
        If TypeName(oG.Items(i)) = "MeetingItem" Then j = j + 1
      Next i
      If j = 0 Then Exit Sub
    ' Create titles
            Range("A1").Offset(0, 0).Value = "SenderName"
            Range("B1").Offset(0, 0).Value = "Subject"
            Range("C1").Offset(0, 0).Value = "CreationTime (Scheduled time of the first appointment)"
            Range("D1").Offset(0, 0).Value = "ReceivedTime (Scheduled time of the current appointment)"
            Range("E1").Offset(0, 0).Value = "Start (start time of the last scheduled appointment)"
            Range("F1").Offset(0, 0).Value = "StartTime (doesnt work yet)"
            Range("G1").Offset(0, 0).Value = "Location"
            Range("H1").Offset(0, 0).Value = "RequiredAttendees"
            Range("I1").Offset(0, 0).Value = "OptionalAttendees"
            Range("J1").Offset(0, 0).Value = "ResponseStatus"
      On Error Resume Next
      j = 0
      For i = 1 To oG.Items.Count
          Set oM = oG.Items(i)
          With oG.Items(i).GetAssociatedAppointment(True)
            j = j + 1
            Range("A1").Offset(j, 0).Value = oM.SenderName
            Range("B1").Offset(j, 0).Value = oM.Subject
            Range("C1").Offset(j, 0).Value = .CreationTime
            Range("D1").Offset(j, 0).Value = oM.ReceivedTime
            Range("E1").Offset(j, 0).Value = .Start
            Range("F1").Offset(j, 0).Value = oAA.GetRecurrencePattern '??????????????????
            Range("G1").Offset(j, 0).Value = .Location
            Range("H1").Offset(j, 0).Value = .RequiredAttendees
            Range("I1").Offset(j, 0).Value = .OptionalAttendees
            Range("J1").Offset(j, 0).Value = .ResponseStatus
          End With
      Next i
      On Error GoTo 0
    Set Folder = Nothing
    Set OutlookNS = Nothing
    Set OutlookApp = Nothing
    End Sub

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Jul 2008
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    VBAX Regular
    Mar 2019
    Alright, sorry, wont do that again. Could you please help me solving my issue?

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts