Scripting Macro for Outlook to Find a Folder

问题

What's the best way to automate this function?

I want to be able to do this in Outlook 2010,

(1)select a specific mail account (2)Key in a folder that I am looking for (3)Then have the macro/program fire off an "*" asterisk (4)Then insert the text that I keyed in step one.

I am trying to automate the search for a folder hot-keys that already exist.

My problem is that I can't type the folder that I am looking for fast enough and all the search programs that I have used are far too slow. The hot-key search is awesome and super fast, I just can't type the folder that I am looking for fast enough. Can this process be automated?

回答1:

You can try this code

Private m_Folder As Outlook.MAPIFolder
Private m_Find As String
Private m_Wildcard As Boolean

Public Sub FindFolder()
  Dim Name$
  Dim Folders As Outlook.Folders

  Set m_Folder = Nothing
  m_Find = ""
  m_Wildcard = False

  Name = InputBox("Find Name:", "Search Folder")
  If Len(Trim$(Name)) = 0 Then Exit Sub
  m_Find = Name

  m_Find = LCase$(m_Find)
  m_Find = Replace(m_Find, "%", "*")
  m_Wildcard = (InStr(m_Find, "*"))

  Set Folders = Application.Session.Folders
  LoopFolders Folders

  If Not m_Folder Is Nothing Then
    If MsgBox("Activate Folder: " & vbCrLf & m_Folder.FolderPath, vbQuestion Or vbYesNo) = vbYes Then
      Set Application.ActiveExplorer.CurrentFolder = m_Folder
    End If
  Else
    MsgBox "Not Found", vbInformation
  End If
End Sub

Private Sub LoopFolders(Folders As Outlook.Folders)
  Dim F As Outlook.MAPIFolder
  Dim Found As Boolean

  For Each F In Folders
    If m_Wildcard Then
      Found = (LCase$(F.Name) Like m_Find)
    Else
      Found = (LCase$(F.Name) = m_Find)
    End If

    If Found Then
      Set m_Folder = F
      Exit For
    Else
      LoopFolders F.Folders
      If Not m_Folder Is Nothing Then Exit For
    End If
  Next
End Sub

Taken from http://www.vboffice.net/sample.html?mnu=2&smp=82&cmd=showitem&lang=en

回答2:

Assuming "\" as a separator, you will need to split the folder name into a list or array of strings and then for each element recursively retrieve the next child folder. Similar to what basher suggested, but with one crucial difference - there is absolutely no reason to loop through all subfolders: Folders.Item in OOM takes either an integer index (1 through Count) or the subfolder name.

E.g. Subfolder = Folder.Folders.Item("Some name") will retrieve a subfolder named "Some name".

EDIT: Sample script (VBA):

strFolderPath = "Subfolder 1\Subfolder 2"
FolderNames = Split(strFolderPath, "\")
'aassuming the path is relative to the currently displayed folder
'or use a top level folder
set RootFolder = Application.ActiveExplorer.CurrentFolder
set CurrentFolder = RootFolder
for each subFolderName in FolderNames
  set CurrentFolder = CurrentFolder.Folders.Item(subFolderName)
next
Debug.Print CurrentFolder.Name

来源：https://stackoverflow.com/questions/17373415/scripting-macro-for-outlook-to-find-a-folder

标签

vb.net

outlook-vba