none
Exporting Meeting Items from Outlook to Excel RRS feed

  • Question

  • Hi

    I am exporting meeting items from Outlook 2010 to Excel 2010 however for some strange reason my routine is not exporting ALL meeting items.  For example for the week 7-13 Mar 16 I have 17 meetings in my calendar but the routine is only exporting 6 meetings for that time period.  My code is shown below and any help/advice would be appreciated:

    Sub ExportAppointmentsToExcel()
        Const SCRIPT_NAME = "Export Appointments to Excel"
        Dim BXstarted As Boolean
        Dim olkFld As Object, _
            olkLst As Object, _
            olkApt As Object, _
            excApp As Object, _
            excWkb As Object, _
            excWks As Object, _
            lngRow As Long, _
            intCnt As Integer
        Set olkFld = Application.ActiveExplorer.CurrentFolder
        If olkFld.DefaultItemType = olAppointmentItem Then
            strFilename = "D:\Email Metrics\Master Email Metrics.xlsm" 'InputBox("Enter a filename (including path) to save the exported appointments to.", SCRIPT_NAME)
            If strFilename <> "" Then
                Set excApp = CreateObject("Excel.Application")
                Set excWkb = excApp.Workbooks.Open(strFilename)
                Set excWks = excWkb.Sheets("PMO_Meetings")
    
                'Write Excel Column Headers
                With excWks
                    .Cells(1, 2) = "Organiser"
                    .Cells(1, 3) = "Category"
                    .Cells(1, 4) = "Subject"
                    .Cells(1, 5) = "Starting Date/Time"
                    .Cells(1, 6) = "End Date/Time"
                End With
                lngRow = 2
                Set olkLst = olkFld.Items
                olkLst.Sort "[Start]"
                olkLst.IncludeRecurrences = True
                'Write appointments to spreadsheet
                For Each olkApt In Application.ActiveExplorer.CurrentFolder.Items
                    'Only export appointments
                    If olkApt.Class = olAppointment Then
                        'Add a row for each field in the message you want to export
                        excWks.Cells(lngRow, 2) = olkApt.Organizer
                        excWks.Cells(lngRow, 3) = olkApt.Categories
                        excWks.Cells(lngRow, 4) = olkApt.Subject
                        excWks.Cells(lngRow, 5) = olkApt.Start
                        excWks.Cells(lngRow, 6) = olkApt.End
                        excWks.Cells(lngRow, 7) = olkApt.Class
                        lngRow = lngRow + 1
                        intCnt = intCnt + 1
                    End If
                Next
                excWks.Columns("A:F").AutoFit
    '            excWkb.Save 'As strFilename
    '            excWkb.Close
                MsgBox "Process complete.  A total of " & intCnt & " appointments were exported.", vbInformation + vbOKOnly, SCRIPT_NAME
            End If
        Else
            MsgBox "Operation cancelled.  The selected folder is not a calendar.  You must select a calendar for this macro to work.", vbCritical + vbOKOnly, SCRIPT_NAME
        End If
        excWkb.Save
        excWkb.Close
        If BXstarted Then excApp.Quit
    
        Set excApp = Nothing
        Set excWB = Nothing
        Set excWks = Nothing
        Set olNS = Nothing
        Exit Sub
    End Sub

    Thanks

    Tony


    TKHussar

    Thursday, March 10, 2016 1:26 PM

Answers

  • Hi, TKHussar

    Do you have any progress, if you want to exporting all mails from an Inbox and it's sub-folders, you could refer to below code:
    Sub Demo()
    
      Dim ns As NameSpace
      Dim inFolder As folder
      
      Set ns = Application.GetNamespace("MAPI")
      
      Set inFolder = ns.GetDefaultFolder(olFolderInbox)
      
      ProcessFolder inFolder
      
    End Sub
    
    
    Sub ProcessFolder(ByVal oParent As folder)
    
        Dim oFolder As folder
        Dim oItem As Object
    
        For Each oItem In oParent.Items
            If oItem.Class = olMail Then
               Debug.Print oItem.Subject
            End If
        Next
    
        If (oParent.Folders.Count > 0) Then
            For Each oFolder In oParent.Folders
                ProcessFolder oFolder
            Next
        End If
            
    End Sub

    • Marked as answer by TKHussar Tuesday, June 19, 2018 10:47 AM
    Wednesday, March 16, 2016 8:59 AM

All replies

  • Hello,

    Are you sure all items have the Class property set to olAppointment ?

    Try to use the Find/FindNext and Restrict methods of the Items class. Read more about these methods in the following articles (sample code is included):

    How To: Use Restrict method in Outlook to get calendar items

    How To: Retrieve Outlook calendar items using Find and FindNext methods

    Thursday, March 10, 2016 1:33 PM
  • Hi Eugene

    Many thanks for the quick response.  I will take a look at the articles and see if that helps me.

    Kind regards

    Tony


    TKHussar

    Thursday, March 10, 2016 1:45 PM
  • Hi TKHussar,

    I was not able to reproduce your issue. Your code works just fine on my PC, all the apppointments/meetings are property exported.

    Are you having meetings lasting for days? It only counts for one item.

    Friday, March 11, 2016 3:07 AM
  • Hi

    Thanks for your response. I have done some further analysys and it appears that it is ignoring recurring appointments even though I think my code say include these.  Any advice appreciated.

    Thanks

    Tony


    TKHussar

    Friday, March 11, 2016 8:56 AM
  • Hello Tony,

    Did it help? What code do you have now with Restrict or Find/FindNext methods?

    Friday, March 11, 2016 12:19 PM
  • Hi Eugene

    Thanks for your note.  I have not had chance to try it yet.  I have an issue with another piece of code that I thought was working exporting ALL mails from an Inbox AND it's sub-folders but it appears to be missing some sub folders during the export.  Just trying to work out why  before I come back to the forum :-(.


    TKHussar

    Friday, March 11, 2016 5:32 PM
  • Hi, TKHussar

    Do you have any progress, if you want to exporting all mails from an Inbox and it's sub-folders, you could refer to below code:
    Sub Demo()
    
      Dim ns As NameSpace
      Dim inFolder As folder
      
      Set ns = Application.GetNamespace("MAPI")
      
      Set inFolder = ns.GetDefaultFolder(olFolderInbox)
      
      ProcessFolder inFolder
      
    End Sub
    
    
    Sub ProcessFolder(ByVal oParent As folder)
    
        Dim oFolder As folder
        Dim oItem As Object
    
        For Each oItem In oParent.Items
            If oItem.Class = olMail Then
               Debug.Print oItem.Subject
            End If
        Next
    
        If (oParent.Folders.Count > 0) Then
            For Each oFolder In oParent.Folders
                ProcessFolder oFolder
            Next
        End If
            
    End Sub

    • Marked as answer by TKHussar Tuesday, June 19, 2018 10:47 AM
    Wednesday, March 16, 2016 8:59 AM