用于 Outlook 查找文件夹的脚本宏

Question

自动化此功能的最佳方法是什么？

我希望能够在 Outlook 2010 中执行此操作，

(1)选择一个特定的邮件帐户 (2)键入我要查找的文件夹 (3)然后让宏/程序触发“*”星号 (4)然后插入我在第一步中键入的文本。

我正在尝试自动搜索已存在的文件夹热键。

我的问题是我无法足够快地键入我正在寻找的文件夹，而且我使用的所有搜索程序都太慢了。热键搜索很棒而且超级快，我只是无法足够快地输入我正在寻找的文件夹。这个过程可以自动化吗？

Answer 1

你可以试试这个代码

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

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

Answer 2

假设“\”作为分隔符，您需要将文件夹名称拆分为字符串列表或数组，然后为每个元素递归检索下一个子文件夹。与 basher 的建议类似，但有一个关键区别 - 绝对没有理由遍历所有子文件夹：OOM 中的 Folders.Item 采用整数索引（1 到 Count）或子文件夹名称。

例如Subfolder = Folder.Folders.Item("Some name") 将检索名为“Some name”的子文件夹。

编辑：示例脚本 (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