Question

我正在尝试建立一个可以按名称查找文件夹的宏。

我已经在此处（Solution Explorer: limit search to selected folder）问了一个与此相关的问题。我的主要问题是我有几个共享邮箱，每个邮箱中都有几个子文件夹，因此找到一个匹配项将花费很多时间（如果不匹配，则花费大约15分钟的加载时间）。我尝试了人们给我的所有解决方案以加快速度，但是我无法实现它们。我认为我的主要问题是文件夹的数量，因此我认为将搜索限制在特定的邮箱可能会解决问题或至少缩短响应时间。问题是：我对VBA不太熟悉，发现了一些代码（http://www.vboffice.net/en/developers/find-folder-by-name/），但是我无法将搜索限制为仅一个邮箱。这是代码：

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

Private Const SpeedUp As Boolean = False
Private Const StopAtFirstMatch As Boolean = False

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

  If SpeedUp = False Then DoEvents

  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
      If StopAtFirstMatch = False Then
        If MsgBox("Found: " & vbCrLf & F.FolderPath & vbCrLf & vbCrLf & 
"Continue?", vbQuestion Or vbYesNo) = vbYes Then
          Found = False
        End If
      End If
    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

如果有人可以提供帮助，我会非常感激。谢谢！

将文件夹搜索限制为仅一个收件箱

0 个答案: