昔作ったシナリオで、保存済みのmsgファイル（メールファイル）から添付のExcelを保存するのに、

・Outlookで開き

・画像マッチングで左ボタン

・エミュレーションで名前を付けて保存

・Outlook終了

を行っていましたが、本日、不具合があり、直そうと思ったのですが、私のPC環境は画面が多く、解像度もバラバラで

画像マッチングがうまく設定できず、こんな不安定なら、そこを作り直そうとライブラリを作成しましたのでご紹介します。

ただ、もし、既にプチライブラリとかスマートライブラリにmsgファイルから添付を取り出すものがあれば、教えてください。

私の作成したものは、下記のとおり簡易的なものです。

Option Explicit

Dim fso
Dim SaveFolderPath
Dim msg
Dim Mydic
Dim olApp
Dim itm
Dim atc
Dim fn

msg = !msgファイル!
SaveFolderPath = !保存フォルダ!

Set fso = CreateObject("Scripting.FileSystemObject")
Set Mydic = CreateObject("Scripting.Dictionary")

Set olApp = CreateObject("Outlook.Application")
Set itm = olApp.GetNamespace("MAPI").OpenSharedItem(msg)
If LCase(TypeName(itm)) = "mailitem" Then
 With fso
  For Each atc In itm.Attachments
   fn = SaveFolderPath & "\" & atc.Filename
   If .FileExists(fn) = True Then
    .DeleteFile (fn)
   End If
   Mydic.Add atc.Filename, .getFileName(msg)
   atc.SaveAsFile fn
  Next
 End With
End If

olApp.Quit
Set itm = Nothing
Set olApp = Nothing
Set Mydic = Nothing
Set fso = Nothing