Solved

Loop Through Outlook Folders using vba

Posted on 2007-12-01
4
20,300 Views
Last Modified: 2013-11-27
I'm missing something in my code... It is not looping further into subfolders (as the msgbox states).
Can you please advise what's missing?  Thanks!

Private Sub cmdEmailFolders2_Click()
'12/1/07 outlook folders button
Dim y As Integer
Dim outApp As New outlook.Application
Dim nsp As outlook.NameSpace
Dim mpf As outlook.MAPIFolder
Dim mpfSubFolder As outlook.MAPIFolder
Dim flds As outlook.Folders
Dim flds2 As outlook.Folders
Dim idx As Integer
Dim myItem As outlook.MailItem
Set nsp = outApp.GetNamespace("MAPI")
Set mpf = nsp.GetDefaultFolder(olFolderInbox)
Set flds = mpf.Folders
Set mpfSubFolder = flds.GetFirst


Dim myNewFolder As outlook.MAPIFolder

Do While Not mpfSubFolder Is Nothing  'client name
    Debug.Print mpfSubFolder.Name
   
    Set myNewFolder = mpfSubFolder
    For i = 1 To myNewFolder.Folders.count  'debt
        Debug.Print myNewFolder.Folders.Item(i) '.Items(1)
         
          If myNewFolder.Folders.Item(i).Folders.count = 0 Then
         
          Else
            For A = 1 To myNewFolder.Folders.Item(i).Folders.count 'client
                     ' Debug.Print myNewFolder.Folders.Item(i) 'debt
                     
                     Set myFolder = myNewFolder.Folders.Item(i).Folders.Item(A) 'open trades
                        Debug.Print myNewFolder.Folders.Item(i).Folders.Item(A)
                        Debug.Print myNewFolder.Folders.Item(i).Folders.Item(A).Items.count
                       
                        For x = 1 To myNewFolder.Folders.Item(i).Folders.Item(A).Items.count
                           Debug.Print myNewFolder.Folders.Item(i).Folders.Item(A).Items(x)
                           
                               Set myItem = myNewFolder.Folders.Item(i).Folders.Item(A).Items(x)
'>>>>>>>>never getting in here
                                MsgBox "never getting to this point even when there are subfolders"
                    Next x
                Next A
               End If 'SUBFOLDER COUNT =0
          Next i
        Set mpfSubFolder = flds.GetNext
    Loop

Exit Sub
End Sub
0
Comment
Question by:dleads
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
4 Comments
 
LVL 44

Expert Comment

by:GRayL
ID: 20389409
0
 
LVL 19

Expert Comment

by:weellio
ID: 20389436
see if this does what you want
Sub superduper()
Dim objFolder As Outlook.MAPIFolder
Dim outApp As New Outlook.Application
Dim nsp As Outlook.NameSpace
Dim mpf As Outlook.MAPIFolder
Dim myItem As Outlook.MailItem
Set nsp = outApp.GetNamespace("MAPI")
Set mpf = nsp.GetDefaultFolder(olFolderInbox)
Set objFolder = OutlookFolderNames(mpf, "somefolder")
 
End Sub
 
 
Public Function OutlookFolderNames(objFolder As Outlook.MAPIFolder, strFolderName As String) As Object
'*********************************************************
'searches recursively through folders until it finds the one you have listed
'just don't list one that exists and it will search them all
 
    On Error GoTo ErrorHandler
    Dim objOneSubFolder As Outlook.MAPIFolder
    If Not objFolder Is Nothing Then
        If LCase(strFolderName) = LCase(objFolder.Name) Then
            Set OutlookFolderNames = objFolder
        Else
            ' Check if folders collection is not empty
            If objFolder.Folders.Count > 0 And _
                   Not objFolder.Folders Is Nothing Then
                For Each oFolder In objFolder.Folders
                    Set objOneSubFolder = oFolder
                    ' only check mail item folder
                    If objOneSubFolder.DefaultItemType _
                         = olMailItem Then
                        If LCase(strFolderName) = _
                          LCase(objOneSubFolder.Name) Then
                            Set OutlookFolderNames = _
                                   objOneSubFolder
                            Exit For
                        Else
                            If objOneSubFolder.Folders.Count _
                                > 0 Then
                                MsgBox "hi"
                                Set OutlookFolderNames = _
                                  OutlookFolderNames _
                                (objOneSubFolder, strFolderName)
                            End If
                        End If
                    End If
                Next
            End If
        End If
    End If
 
    Exit Function
 
ErrorHandler:
    Set OutlookFolderNames = Nothing
End Function

Open in new window

0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 20389530
To recursively pass through all outlook folders you could try the following, I appreciate it doesn't follow your own code but I have used it successfully elsewhere:

Chris


Sub launchpad()
 
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim MyFolder As Outlook.MAPIFolder
    On Error Resume Next
    
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set MyFolder = objNS.PickFolder
    Call ProcessFolder(MyFolder)
    Set objNS = Nothing
 
Set MyFolder = Nothing
Set olApp = Nothing
Set objNS = Nothing
 
End Sub
 
 
Sub ProcessFolder(StartFolder As MAPIFolder)
Dim objFolder As Outlook.MAPIFolder
Dim objItem As Object
Dim mai As mailitem
    On Error Resume Next
'    MsgBox StartFolder.Path, , "testing"
    
    ' process all the items in this folder
'    For Each objItem In StartFolder.Items
'        If TypeName(objItem) = "MailItem" Then
'            Set mai = objItem
'        End If
'    Next
        
    ' process all the subfolders of this folder
    For Each objFolder In StartFolder.Folders
        Call ProcessFolder(objFolder)
    Next
 
Set mai = Nothing
Set objFolder = Nothing
Set objItem = Nothing
End Sub

Open in new window

0
 

Author Closing Comment

by:dleads
ID: 31427379
Wellio, unfortuantely, your code does not go into the level that I need.  It happens to get to the same level as my posted code.

chris_bottomley's code best suited my needs.  

Thank you all.
0

Featured Post

[Webinar] Code, Load, and Grow

Managing multiple websites, servers, applications, and security on a daily basis? Join us for a webinar on May 25th to learn how to simplify administration and management of virtual hosts for IT admins, create a secure environment, and deploy code more effectively and frequently.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Preparing an email is something we should all take special care with – especially when the email is for somebody you may not know very well. The pressures of everyday working life stacked with a hectic office environment can make this a real challen…
It’s the first day of March, the weather is starting to warm up and the excitement of the upcoming St. Patrick’s Day holiday can be felt throughout the world.
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

737 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question