none
Outlook 2013 - Traversing Subdirectories RRS feed

  • Question

  • Hello, 

    I have a code that should calculate the response time for each and every email in inbox and then its sub-directories regardless of how many there are and finally copy it to Excel. There's a blueprint and then another suggestion on how to accomplish this.

    Question: How do you loop through all sub-directories and calculate response time (though I figured out the response time in my Excel code).

    This is my starting code.

    Sub ResponseTime()
     On Error Resume Next

    'Start Outlook
     Set myOlApp = Outlook.Application
     Set myNamespace = myOlApp.GetNamespace("mapi")
     Set myfolder = myOlApp.ActiveExplorer.CurrentFolder

    'Start Excel
    Set xlobj = CreateObject("excel.application.15")
     xlobj.Visible = True
     xlobj.Workbooks.Add
     xlobj.Worksheets("Sheet1").Name = "Statusmail"

    'Set the headers in Excel
     xlobj.Range("a" & 1).Value = "Sent On"
     xlobj.Range("a" & 1).Font.Bold = "True"
     xlobj.Range("b" & 1).Value = "Received Time"
     xlobj.Range("b" & 1).Font.Bold = "True"
     xlobj.Range("c" & 1).Value = "Response Time"
     xlobj.Range("c" & 1).Font.Bold = "True"

    'Adjust columns to autofit in Excel
     Worksheets("Statusmail").Columns("A:C").AutoFit
    ' xlobj.Range("c" & 1).Value = "Task"
    ' xlobj.Range("c" & 1).Font.Bold = True

    'Loop through all email items in Outlook
    For i = 1 To myfolder.Items.Count
      Set myitem = myfolder.Items(i)
     ' msgtext = myitem.Body

    'Move data from Outlook to Excel
      xlobj.Range("a" & i + 1).Value = Format(myitem.SentOn, "h:mm:ss")
      xlobj.Range("b" & i + 1).Value = Format(myitem.ReceivedTime, "h:mm:ss")
      xlobj.Range("c" & i + 1).Value = Format(xlobj.Range("b" & i + 1) - xlobj.Range("a" & i + 1), "h:mm:ss")


    ' Total number of records - (minus) 1 e.g. not including the headers
     Next
    MsgBox ("Done! Total number of records: " & i - 1), , "Finished..."
    End Sub

    Here is also an example but I cannot get it to work.

    Sub ProcessFolder(CurrentFolder As Outlook.MAPIFolder)
             
        Dim i As Long
        Dim olNewFolder As Outlook.MAPIFolder
        Dim olTempFolder As Outlook.MAPIFolder
        Dim olTempFolderPath As String
    '    Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
         ' Loop through the items in the current folder.
        For i = CurrentFolder.Folders.Count To 1 Step -1
              
            Set olTempFolder = CurrentFolder.Folders(i)
          '---> Why?  Debug.Print olTempFolder.senton
          
            olTempFolderPath = olTempFolder.FolderPath
              
             'prints the folder path and name in the VB Editor's Immediate window
             Debug.Print olTempFolderPath
               
            ' prints the folder name only
             ' Debug.Print olTempFolder
              
             ' create a string with the folder names.
             ' use olTempFolder if you want foldernames only
             strFolders = strFolders & vbCrLf & olTempFolderPath
            
             
            lCountOfFound = lCountOfFound + 1
              
        Next
         ' Loop through and search each subfolder of the current folder.
        For Each olNewFolder In CurrentFolder.Folders
              
             'Don't need to process the Deleted Items folder
            If olNewFolder.Name <> "Deleted Items" Then
                ProcessFolder olNewFolder
                
            End If
              
        Next
          
    End Sub


    Thursday, August 21, 2014 1:16 PM

Answers

  • To start with Inbox use NameSpace.GetDefaultFolder(olFolderInbox). Then call your ProcessFolders() sub recursively, passing the Inbox to start.

    Ken Slovak MVP - Outlook

    Thursday, August 21, 2014 1:28 PM
    Moderator

All replies

  • Hello Nick,

    You need to call the ProcessFolder method recursively to process all folders. For example:

    Private Sub processFolder(ByVal oParent As Outlook.MAPIFolder)
    
            Dim oFolder As Outlook.MAPIFolder
            Dim oMail As Outlook.MailItem
    
            For Each oMail In oParent.Items
    
            'Get your data here ...
    
            Next
    
            If (oParent.Folders.Count > 0) Then
                For Each oFolder In oParent.Folders
                    processFolder (oFolder)
                Next
            End If
    End Sub

    Did you try to debug the code? Do you get any errors?

    Thursday, August 21, 2014 1:24 PM
  • To start with Inbox use NameSpace.GetDefaultFolder(olFolderInbox). Then call your ProcessFolders() sub recursively, passing the Inbox to start.

    Ken Slovak MVP - Outlook

    Thursday, August 21, 2014 1:28 PM
    Moderator