Как автоматически переместить отправленные встречи в определенную папку в Outlook?
Обычно после отправки писем или встреч, они оба оказываются в папке Отправленные. Таким образом, папка Отправленные может стать довольно беспорядочной и громоздкой. В этой статье я представлю метод автоматического перемещения отправленных встреч в другую папку сразу после отправки встречи.
Автоматическое перемещение отправленных встреч в определенную папку с помощью кода VBA
Автоматическое перемещение отправленных встреч в определенную папку с помощью кода VBA
Чтобы автоматически переместить все отправленные приглашения на встречу в другую папку, следующий код может вам помочь, выполните следующие действия:
1. Нажмите и удерживайте клавиши ALT + F11, чтобы открыть окно Microsoft Visual Basic для приложений.
2. В окне Microsoft Visual Basic для приложений дважды щелкните ThisOutlookSession в области Project1(VbaProject.OTM), чтобы открыть модуль, затем скопируйте и вставьте следующий код в пустой модуль.
Код VBA: Автоматическое перемещение отправленных встреч в определенную папку
Private WithEvents GExplorer As Outlook.Explorer
Public WithEvents GSentFolder As Outlook.Folder
Public WithEvents GSentItems As Outlook.Items
Private Sub Application_Startup()
Set GExplorer = Outlook.Application.ActiveExplorer
End Sub
Private Sub GExplorer_SelectionChange()
Dim xFolder As Folder, xRootFolder As Folder
Dim xRootFldName As String
Dim xPos As Integer
On Error Resume Next
Set xFolder = Outlook.Application.ActiveExplorer.CurrentFolder
xPos = VBA.InStr(3, xFolder.FolderPath, "\")
If xPos > 0 Then
xRootFldName = VBA.Mid(xFolder.FolderPath, 3, xPos - 3)
Else
xRootFldName = VBA.Mid(xFolder.FolderPath, 3, Len(xFolder.FolderPath) - 2)
End If
Set xRootFolder = Outlook.Application.Session.Folders(xRootFldName)
Set GSentFolder = xRootFolder.Folders("Sent Items")
Set GSentItems = GSentFolder.Items
End Sub
Private Sub GSentItems_ItemAdd(ByVal Item As Object)
Dim xMeetingItem As Outlook.MeetingItem
Dim xTargetFolder As Outlook.Folder
On Error Resume Next
If Item.Class <> olMeetingRequest Then Exit Sub
Set xMeetingItem = Item
Set xTargetFolder = GSentFolder.Folders("Meetings")
If xTargetFolder Is Nothing Then
Set xTargetFolder = GSentFolder.Folders.Add("Meetings")
End If
xMeetingItem.Move xTargetFolder
End Sub
3. Затем сохраните и закройте окно кода. Теперь, когда письмо с встречей отправляется, оно будет автоматически перемещено в новую папку под названием Meetings внутри папки Отправленные, см. скриншот:
Лучшие инструменты для повышения продуктивности в Office
Срочные новости: Выпущена бесплатная версия Kutools для Outlook!
Оцените совершенно новый Kutools для Outlook с более чем100 потрясающими функциями! Нажмите, чтобы скачать сейчас!
📧 Автоматизация Email: Автоответчик (доступно для POP и IMAP) / Запланировать отправку Email / Авто Копия/Скрытая копия по правилу при отправке письма / Автоматическое перенаправление (Расширенное правило) / Автоматически добавить приветствие / Автоматическое разделение Email с несколькими получателями на отдельные сообщения ...
📨 Управление Email: Отозвать письмо / Блокировать мошеннические Email по теме и другим признакам / Удалить дубликаты писем / Расширенный Поиск / Организовать папки ...
📁 Вложения Pro: Пакетное сохранение / Пакетное открепление / Пакетное сжатие / Автосохранение / Автоматическое отсоединение / Автоматическое сжатие ...
🌟 Магия интерфейса: 😊Больше красивых и современных Эмодзи / Напоминания о важных письмах / Сворачивание Outlook вместо закрытия ...
👍 Мгновенные действия в один клик: Ответить всем с вложениями / Антифишинг Email / 🕘Показать часовой пояс отправителя ...
👩🏼🤝👩🏻 Контакты и Календарь: Пакетное добавление контактов из выбранных Email / Разделить группу контактов на отдельные группы / Удалить напоминание о дне рождения ...
Используйте Kutools на вашем любимом языке – поддерживается английский, испанский, немецкий, французский, китайский и более40 других языков!
