VBScriptでOutlookのメールファイル(msg)から貼付ファイルを取り出す。
概要
複数のメールにある貼付ファイルを一気に取得したい!
ただし、OutlookのVBAは勘弁な!ということで作りました。
このソースを ExtractAttachments.vbs
みたいに保存して、
msgファイルをドラッグアンドドロップするとmsgファイルのディレクトリにモリモリ添付ファイルを取り出してくれます。
なお、元ファイルの名前の末尾に貼付ファイル名を追加するため、名前が重複することはありません。
ソースコード
Dim args, arg ' 許可されている拡張子 Set AllowedExtensions = CreateObject("Scripting.Dictionary") AllowedExtensions.Add "msg" , 0 Set args = WScript.Arguments ' 引数のチェック。対象ファイル以外が混ざっている場合終了。 set fobj = CreateObject("Scripting.FileSystemObject") For Each arg In args ext = fobj.GetextensionName(arg) if not AllowedExtensions.Exists(ext) then msgbox "msgファイル以外が指定されました。終了します。" WScript.Quit end if Next Set appOL = CreateObject("Outlook.Application") For Each path In args Set msg = appOL.CreateItemFromTemplate(path) for each atc in msg.Attachments atc.SaveAsFile path & "." & atc.DisplayName next Next msgbox "抽出完了しました。"
感想
やはりOffice系をいじるのはVBScriptが一番かなあと思う事が多いです。
以上!