title: outlook vba select messages in sub-folder
body: <p>Outlook 2007  is configured with two email accounts:</p>
  
  <ul>
  <li>Account#1: Hotmail</li>
  <li>Account#2: Gmail</li>
  </ul>
  
  <p>I would like to create a macro named simulating a user doing the following: </p>
  
  <ul>
  <li>Left click on a  within either the hotmail or gmail account.</li>
  <li>Highlight all messages within the folder previously selected.</li>
  <li>display a messageBox with the number of emails selected from this folder</li>
  </ul>
  
  <p>I have tried several methods to define the folder, but its not working.  My suspicion is it would work on the default PST, but that isn't what I'm using.  Even tried using the method below to identify the specific folder I want to use.  It does print out a path, but I am not able to use that as a variable value directly.  </p>
  
  <p>Any suggestions?</p>
  
  <p>=== Information ===</p>
  
  <p>The following macro was used to obtain information about the account &amp; folder locations:
  <a href="http://www.gregthatcher.com/Scripts/VBA/Outlook/GetFolderInfo.aspx" rel="nofollow">http://www.gregthatcher.com/Scripts/VBA/Outlook/GetFolderInfo.aspx</a></p>
  
  <ol>
  <li>Hotmail
  <ul>
  <li>Name: aaaaa</li>
  <li>FolderPath: \@hotmail.com\aaaaa</li>
  </ul></li>
  </ol>
  
  <p>-</p>
  
  <ol start="2">
  <li>Gmail
  <ul>
  <li>Name: bbbbb</li>
  <li>FolderPath: \@gmail.com\bbbbb </li>
  </ul></li>
  </ol>
  
  <hr>
  
  <pre><code>' please add your values for Const emailAccount  and  Const folderToSelect
  ' To begin, launch: start_macro
  '
  ' the macro will loop all folders and will check two things , folder name and account name,
  ' when both are matched , will make that folder the active one , then will select all emails
  ' from it and at final will issue number of selected items no other References are required
  ' than default ones
  
  Option Explicit
  
  #If VBA7 Then
      Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
  #Else
      Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
  #End If
  
  
  
  ' please provide proper values for email account and folder name
  Const emailAccount = "username@hotmail.com"
  Const folderToSelect = "folder"
  
  
  
  ' declare some public variables
  Dim mySession As Outlook.NameSpace
  Dim myExplorer As Outlook.Explorer
  Dim mySelection As Outlook.Selection
  Dim my_folder As Outlook.folder
  
  Sub start_macro()
  
      Dim some_folders As Outlook.Folders
      Dim a_fld As Variant
      Dim fld_10 As Outlook.folder
  
      Set mySession = Application.Session
      Set some_folders = mySession.Folders
  
      For Each a_fld In some_folders
          Set fld_10 = a_fld
          Call loop_subfolders_2(fld_10)
      Next a_fld
  
  End Sub
  
  Sub final_sub()
      If Not (my_folder Is Nothing) Then
          Set myExplorer = Application.ActiveExplorer
          Set Application.ActiveExplorer.CurrentFolder = my_folder
          Call select_all_items(my_folder)
      Else
          MsgBox "There is no folder available for specified account !!!"
      End If
  
  
      End     'end the macro now
  
  End Sub
  
  Sub loop_subfolders_2(a_folder As Outlook.folder)
  
      Dim col_folders As Outlook.Folders
      Dim fld_1 As Outlook.folder
      Dim arr_1 As Variant
  
      Set col_folders = a_folder.Folders
  
      For Each fld_1 In col_folders
          If Left(fld_1.FolderPath, 2) = "\\" Then
              arr_1 = Split(fld_1.FolderPath, "\")
              'Debug.Print fld_1.Name &amp; vbTab &amp; arr_1(2) &amp; vbTab &amp; fld_1.FolderPath
              If InStr(LCase(emailAccount), "@gmail.com") &gt; 0 Then
                  If LCase(folderToSelect) = LCase(fld_1.Name) Then
                      If LCase(emailAccount) = LCase(arr_1(2)) Or arr_1(2) = "Personal Folders" Then
                          Set my_folder = fld_1
                          Call final_sub
                      Else
                          Call loop_subfolders_2(fld_1)
                      End If
                  Else
                      Call loop_subfolders_2(fld_1)
                  End If
              Else
                  If LCase(folderToSelect) = LCase(fld_1.Name) And LCase(emailAccount) = LCase(arr_1(2)) Then
                      Set my_folder = fld_1
                      Call final_sub
                  Else
                      Call loop_subfolders_2(fld_1)
                  End If
              End If
          End If
      Next fld_1
  
  End Sub
  
  Sub select_all_items(my_folder As Outlook.folder)
  
      Dim my_items As Outlook.Items
      Dim an_item As MailItem
      Dim a  As Long, b As Long
  
      Set my_items = my_folder.Items
      b = my_items.Count
      DoEvents
      'sleep 2000
      Set mySelection = myExplorer.Selection
  
      If CLng(Left(Application.Version, 2)) &gt;= 14 Then
          On Error Resume Next    '   there are other folders that do not contains mail items
              For Each an_item In my_items
                  If myExplorer.IsItemSelectableInView(an_item) Then
                      myExplorer.AddToSelection an_item
                  Else
                  End If
              Next an_item
          On Error GoTo 0
      Else
          myExplorer.Activate
          If b &gt;= 2 Then
              For a = 1 To b - 1
                  SendKeys "{DOWN}"
                  'Sleep 50
              Next a
              For a = 1 To b - 1
                   SendKeys "^+{UP}"
  '                'Sleep 50
              Next a
          End If
          DoEvents
          'sleep 2000
      End If
      Set my_items = Nothing
      Set mySelection = myExplorer.Selection
      MsgBox mySelection.Count
  
  End Sub
  </code></pre>