Переместить сообщения Outlook в архив по нажатию горячей клавиши

После того как я променял The Bat! на Outlook мне очень не хватало одной важной функциональности. В старичке можно было настроить так, чтоб по нажатию Shift+Del выбранную группу писем переносило в любую другую папку вместо Удаленных. В Outlook, чтобы держать Inbox в чистоте, приходится мучаться драг-н-дропом. Но, к счастью, оказалось горячую клавишу можно настроить и для Outlook.

Для этого необходимо будет:
1. Определиться с папкой куда переносить,
2. Создать макрос (код ниже) и вписать в него имя папки,
3. Разместить новую кнопку на тулбаре,
4. Задать кнопке «горячую клавишу».

Это не так сложно и займет всего минут пять-десять если следовать инструкциям ниже.

Для начала откроем окно создания макросов в Outlook (нажав Alt-F8), и в качестве названия макроса введем, например, MoveSelectedMessagesToFolder, после чего кликнем Создать (Create).



Далее появится страшное и непонятное окно редактирования макросов Microsoft Visual Basic с болванкой для нового скрипта:

Sub MoveSelectedMessagesToFolder()

End Sub

Однако не стоит конфузиться, ни строчки кода вам писать не придется (за исключением исправления одной мелочи). Просто замените весь код на приведенный ниже:

Option Explicit

Sub MoveSelectedMessagesToFolder()
On Error Resume Next

Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)

Set objFolder = objInbox.Folders("<u>Archive</u>")

If objFolder Is Nothing Then
    MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
End If

If Application.ActiveExplorer.Selection.Count = 0 Then
    ' Require that this procedure be called only when a message is selected
    Exit Sub
End If

For Each objItem In Application.ActiveExplorer.Selection
    If objFolder.DefaultItemType = olMailItem Then
        If objItem.Class = olMail Then
            objItem.Move objFolder
        End If
    End If
Next

Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing

End Sub

Обратите внимание, название папки в которую будут перемещаться письма я выделил подчеркиванием. В моем случае она называется «Archive», если хотите укажите любую другую. Это должна быть одна из существующих папок во Входящих (Inbox).

Вы можете проверить работает ли макрос запустив его зеленой кнопкой play вверху. Если всё пройдет ок, то письмо которое во Входящих сейчас выделено попадет в нужную папку.

После того как вы закончили со скриптом сохраните его (Ctrl+S) и закройте окно редактора скриптов.

Теперь вынесем новую кнопку в тулбар. Для этого нажимаем правой кнопкой на тулбаре и выберем пункт Настройка… (Customize…). Появится следующее окно:



Находим в категории Макросы наш единственный макрос и перетаскиваем его куда-нибудь в область тулбара (но не в меню). Не закрывая окошко Настроек (если закрыли откройте его снова) кликаем правой клавишей на появившейся кнопке на тулбаре и выбираем ей подходящий значок и имя, например «Переместить &в архив». Чтобы у кнопки была горячая клавиша нужно поставить значок & перед любой буквой в имени которое вы назначили. Тогда вы сможете вызывать макрос сочетанием клавиш Alt+буква (Alt+в в нашем случае). Теперь можно закрыть окно настроек и проверить работает ли горячая клавиша.

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

Вуаля. Надеюсь, у вас все получилось. Если что-то не вышло, с удовольствием помогу в комментариях.