Перейти к основному содержанию

Как найти папку (полный путь к папке) по имени папки в Outlook?

Например, на панели навигации вы перемещаете папку и по ошибке попадаете в неизвестную папку в Outlook, вы хотите восстановить эту папку, но не можете сразу ее обнаружить. К сожалению, Outlook не поддерживает Найдите функция такая же, как в Microsoft Word или Excel. Не волнуйтесь! Вы можете применить макрос VBA для решения этой проблемы в Outlook.

Быстрый поиск и открытие папок по имени папки с помощью удивительного инструмента

В общем, мы можем искать папки по имени папки с кодом VBA. Большая часть кода VBA может искать папки в текущем почтовом ящике и открывать только первую найденную папку. Теперь с функцией Go To в Kutools for Outlook вы можете легко находить папки по имени папки и открывать любую из найденных папок по мере необходимости.



Найти папку (полный путь к папке) по имени папки с помощью VBA

Выполните следующие шаги для поиска папок по именам папок с помощью VBA в Outlook.

1, нажмите другой + F11 вместе, чтобы открыть окно Microsoft Visual Basic для приложений.

2. Нажмите Вставить > Модули, а затем вставьте ниже код VBA в новое окно модуля.

VBA: поиск и открытие папок по имени папки в Outlook

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

Private Const SpeedUp As Boolean = True
Private Const StopAtFirstMatch As Boolean = True

Public Sub FindFolder()
Dim sName As String
Dim oFolders As Folders

  Set m_Folder = Nothing
m_Find = ""
m_Wildcard = False

  sName = InputBox("Find:", "Search folder")
If Len(Trim(sName)) = 0 Then Exit Sub
m_Find = sName

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

  Set oFolders = Application.Session.Folders
LoopFolders oFolders

  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 oFolder As MAPIFolder
Dim bFound As Boolean

If SpeedUp = False Then DoEvents

  For Each oFolder In Folders
If m_Wildcard Then
bFound = (LCase(oFolder.Name) Like m_Find)
Else
bFound = (LCase(oFolder.Name) = m_Find)
End If

    If bFound Then
If StopAtFirstMatch = False Then
If MsgBox("Found: " & vbCrLf & oFolder.FolderPath & vbCrLf & vbCrLf & "Continue?", vbQuestion Or vbYesNo) = vbYes Then
bFound = False
End If
End If
End If
If bFound Then
Set m_Folder = oFolder
Exit For
Else
LoopFolders oFolder.Folders
If Not m_Folder Is Nothing Then Exit For
End If
Next
End Sub

3, нажмите F5 ключ или щелкните Run кнопку для запуска этого VBA.

4. В появившемся диалоговом окне «Папка поиска» введите указанное имя папки, по которой будет выполняться поиск, и щелкните значок OK кнопка. Смотрите скриншот:

Внимание: Этот VBA поддерживает подстановочный знак звездочки. Например, вы можете ввести тес * чтобы узнать все папки, названия которых начинаются с TES.

5. Теперь появляется диалоговое окно, в котором отображается путь к найденной папке. Если вам нужно открыть найденную папку, нажмите кнопку Да .

И теперь найденная папка открывается на панели навигации, как показано ниже:

Внимание: Если существует несколько папок с указанным именем, этот VBA может найти и открыть только одну папку.


Поиск папки по имени папки с помощью удивительного инструмента

Если у вас установлен Kutools for Outlook, вы можете применить его функцию «Перейти к», чтобы быстро найти все папки по определенному имени папки, а также легко открыть любые найденные папки.

Kutools for Outlook: Расширьте возможности Outlook, добавив в него более 100 необходимых инструментов. Тест-драйв БЕСПЛАТНО в течение 60 дней без каких-либо условий!   Больше информации...   Скачать

1. Нажмите Кутулс Плюс > Перейти к для включения этой функции.

2. В диалоговом окне "Перейти к" введите указанное имя папки в поле Поиск поле, выберите папку в результатах поиска и щелкните значок Ok .

Теперь указанная папка с определенным именем найдена и сразу же открыта.


Статьи по теме:


Лучшие инструменты для офисной работы

Kutools for Outlook - Более 100 мощных функций для улучшения вашего Outlook

🤖 Почтовый помощник с искусственным интеллектом: Мгновенные профессиональные электронные письма с помощью магии искусственного интеллекта: гениальные ответы одним щелчком мыши, идеальный тон, многоязычное владение. Преобразуйте электронную почту без особых усилий! ...

???? Автоматизация электронной почты: Нет на месте (доступно для POP и IMAP)  /  Расписание отправки писем  /  Автоматическое копирование/скрытая копия по правилам при отправке электронной почты  /  Автопересылка (расширенные правила)   /  Автоматическое добавление приветствия   /  Автоматически разделять электронные письма от нескольких получателей на отдельные сообщения ...

📨 Управление электронной почтой: Легко вспоминать электронные письма  /  Блокировка мошеннических писем от субъектов и других лиц  /  Удалить повторяющиеся электронные письма  /  Поиск  /  Объединение папок ...

📁 Вложения ProПакетное сохранение  /  Пакетное отсоединение  /  Пакетное сжатие  /  Автосохранение   /  Авто отсоединение  /  Автоматическое сжатие ...

???? Магия интерфейса: 😊Больше красивых и крутых смайлов   /  Повысьте производительность Outlook с помощью представлений с вкладками  /  Свернуть Outlook вместо закрытия ...

???? Чудеса в один клик: Ответить всем с входящими вложениями  /   Антифишинговые письма  /  🕘Показать часовой пояс отправителя ...

👩🏼‍🤝‍👩🏻 Контакты и календарь: Пакетное добавление контактов из выбранных писем  /  Разделить группу контактов на отдельные группы  /  Удалить напоминания о днях рождения ...

Более Особенности 100 Ждем вашего исследования! Нажмите здесь, чтобы узнать больше.

 

 

Comments (10)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Thank you for this great macro. I have used it extensively over the past 2 years. My employer switched from Office 16 to Office 365 and since then, this macro is VERY slow. Is there any way to optimize it for Office 365?
Thanks!
This comment was minimized by the moderator on the site
This macro has really helped me is incredible, thank you!!!
Is it possible to to go to the next occurrence, so instead of just Yes/No have something as Yes/Next/No ?
Thank you
This comment was minimized by the moderator on the site
Private m_Folder As MAPIFolder
Private m_Find As String
Private m_Wildcard As Boolean

Private Const SpeedUp As Boolean = True
'Private Const StopAtFirstMatch As Boolean = True
Private StopAtFirstMatch As Boolean

Public Sub FindFolder()
Dim sName As String
Dim oFolders As Folders

Set m_Folder = Nothing
m_Find = ""
m_Wildcard = False

sName = InputBox("Find:", "Search folder")
If Len(Trim(sName)) = 0 Then Exit Sub

'm_Find = sName
' Added "*"... for any given string in the folder name
m_Find = "*" & sName & "*"

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

' Set oFolders = Application.Session.Folders
Set oFolders = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders

LoopFolders oFolders

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

Private Sub LoopFolders(Folders As Outlook.Folders)
Dim oFolder As MAPIFolder
Dim bFound As Boolean

If SpeedUp = False Then DoEvents

For Each oFolder In Folders
If m_Wildcard Then
bFound = (LCase(oFolder.Name) Like m_Find)
Else
bFound = (LCase(oFolder.Name) = m_Find)
End If


If bFound Then
If StopAtFirstMatch = False Then
Set Application.ActiveExplorer.CurrentFolder = oFolder

If MsgBox("Found: " & vbCrLf & oFolder.FolderPath & vbCrLf & vbCrLf & "Search for next?", vbQuestion Or vbYesNo) = vbYes Then
bFound = False
End If
Else
MsgBox ("Not found")
End If
End If
If bFound Then
Set m_Folder = oFolder
Exit For
Else
LoopFolders oFolder.Folders
If Not m_Folder Is Nothing Then Exit For
End If
Next
End Sub
This comment was minimized by the moderator on the site
Hi, if i try to copy and past the macro yes/next/no, I only received the message "Search End".
Could you take a look? I would really appreciate it. Thanks
This comment was minimized by the moderator on the site
Hi, if i try to copy and past the macro yes/next/no, I only received the message "Search End".Could you take a look? I would really appreciate it. Thanks
This comment was minimized by the moderator on the site
Wow this is exactly. I really appreciate it and you did it so fast.Thanks
This comment was minimized by the moderator on the site
Hello,

Thank you for this macro. It works great!


Is there a way to make the macro always search as wildcards? I would be easier to just type a keyword without adding the asterisks every time.
This comment was minimized by the moderator on the site
Replace Line 18 with

m_Find = "*" & sName & "*"
This comment was minimized by the moderator on the site
Replace Line 18 with
m_Find = "*" & sName & "*"
This comment was minimized by the moderator on the site
Hello.

Wow - this is an amazing function, which will make my daily usage of Outlook tons faster.
Thank you so much for publishing!!

A tip for those interested:
If you want to search only INBOX-folders, without public folders etc.
This made it a lot faster for me because the public folder are remote, so the search is quite slow.
And also I'm not interested in those results.


Replace line 24 with:

Set oFolders = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations