[AHK]Outlookの送信済みアイテムフォルダーに移動するショートカットキーを作る。

Outlookを使うときキーボードショートカットで、送信済みアイテムフォルダーに移動したいと思ったんだけど、Outlookには存在しなかった。

調べてみると、OutlookはCOMから操作できるようだったんで、wshでscript書いてAutoHotKeyで動かすことにした。

Outlookの制御

この辺とか参考にして作ってみた。

下記のスクリプトを適当なテキストファイルにコピペして、ファイル名を「MoveFolder_SentMail.vbs」みたいな感じにして保存。

'MoveFolder_SentMail.vbs
Dim objOlApp
Set objOlApp = CreateObject("Outlook.Application")
Dim objFolder

Dim NS_OL
set NS_OL = objOlApp.GetNamespace("MAPI")
'oldefaultfolders 列挙 (Outlook)
'https://docs.microsoft.com/ja-jp/office/vba/api/outlook.oldefaultfolders
Set objFolder = NS_OL.GetDefaultFolder(5)	'5: 送信済みフォルダーを指定
Set objOlApp.ActiveExplorer.CurrentFolder = objFolder

Set NS_OL = Nothing
Set objFolder = Nothing
Set objOlApp = Nothing

このvbsファイルをダブルクリックすると、今開いてるOutlookのフォルダが送信済みアイテムに移動する。

今回は、GetDefaultFolderで5を指定して送信済みフォルダーに移動するようにしたけど、oldefaultfolders の該当する番号を指定すれば、下書きフォルダー(16)、削除済みアイテム、迷惑メールフォルダ何かも指定できる。(未トライ)

AutoHotKeyからの実行

後は、AutoHotKeyからRunすれば終わりだと思ったんだけど、地味に手間取った。AHKからRunで走らせると、下記のようなエラーが発生。

エラー: ActiveXコンポーネントはオブジェクトを作成できません。:’Outlook.Application’
コード: 800A01AD
ソース: Microsoft VBScript実行時エラー

 VBSをダブルクリックすると、Outlookは正しく送信済みアイテムに移動する。
AutoHotKeyは、管理者権限で実行しているアプリも操作するため、管理者として実行している。もしかして、管理者権限がらみか?と思い、コマンドプロンプトを管理者権限で起動し実行してみた。結果はこっちでも、同様のエラーが発生。コマンドプロンプトを非管理者として起動して実行してみると問題なく実行できた。どうも管理者として実行してると、OutlookのCOMコンポーネントが生成出来ないみたいだ。
 調べてみると、RunAsで一般ユーザーを指定してするれば非管理者として実行できるようだった。しかしながら、ahkファイルにユーザー名、パスワード、ドメイン名を記載することになるため、セキュリティ的に良くないし、スクリプトをそのまま他のPCで使えなくなる。そこでほかの方法が無いか調べたところ、teratailに同じようなこと質問して人がいた。

参考にして下記のような感じでahkファイルに書き込んだら、Ctrl+Shift+sで送信済みアイテムに移動できるようになりました。

;OUTLOOK
#IfWinActive,ahk_exe OUTLOOK.EXE
^+s::
	ShellRun("C:\scripts\MoveFolder_SentMail.vbs"); 作ったOutlook制御のスクリプトパスを指定
	KeyWait,s		;連打防止
return
#IfWinActive

; SHELLRUN
;If the script is not elevated, relaunch as administrator and kill current instance
;if not A_IsAdmin
;{
;   Run *RunAs "%A_ScriptFullPath%"
;   ExitApp
;}
;Parameters for ShellRun
;1 application to launch
;2 command line parameters
;3 working directory for the new process
;4 "Verb" (For example, pass "RunAs" to run as administrator)
;5 Suggestion to the application about how to show its window - see the msdn link for possible values
ShellRun(prms*)
{
    shellWindows := ComObjCreate("{9BA05972-F6A8-11CF-A442-00A0C90A8F39}")
    desktop := shellWindows.Item(ComObj(19, 8)) ; VT_UI4, SCW_DESKTOP                

    ; Retrieve top-level browser object.
    if ptlb := ComObjQuery(desktop
        , "{4C96BE40-915C-11CF-99D3-00AA004AE837}"  ; SID_STopLevelBrowser
        , "{000214E2-0000-0000-C000-000000000046}") ; IID_IShellBrowser
    {
        ; IShellBrowser.QueryActiveShellView -> IShellView
        if DllCall(NumGet(NumGet(ptlb+0)+15*A_PtrSize), "ptr", ptlb, "ptr*", psv:=0) = 0
        {
            ; Define IID_IDispatch.
            VarSetCapacity(IID_IDispatch, 16)
            NumPut(0x46000000000000C0, NumPut(0x20400, IID_IDispatch, "int64"), "int64")

            ; IShellView.GetItemObject -> IDispatch (object which implements IShellFolderViewDual)
            DllCall(NumGet(NumGet(psv+0)+15*A_PtrSize), "ptr", psv
                , "uint", 0, "ptr", &IID_IDispatch, "ptr*", pdisp:=0)

            ; Get Shell object.
            shell := ComObj(9,pdisp,1).Application

            ; IShellDispatch2.ShellExecute
            shell.ShellExecute(prms*)
            ObjRelease(psv)
        }
        ObjRelease(ptlb)
    }
}

ShellRun便利。有難く使わせてもらいます。(コードのネタ元はここかな?)

Follow me!

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です