以下のようにした。
クラス定義しており、使用時はnew Emailの後ファイルパスをsetPathで指定するか、ショートカットのEMに引数でファイルパスを与えて呼ぶ、のいずれか。
Option Explicit
'shortcut
Function EM(ByVal path)
Dim ret
Set ret = New EMail
ret.setPath(path)
Set EM = ret
End Function
Class EMail
Private path
Private fs
'コンストラクタ
Private Sub Class_Initialize()
Set fs = WScript.CreateObject("Scripting.FileSystemObject")
path = ""
End Sub
' デストラクタ
Private Sub Class_Terminate()
Set fs = Nothing
End Sub
Public Sub setPath(ByVal spec)
If spec <> "" Then
path = spec
End If
End Sub
Public Function SaveAttachment(outpath)
Dim temp
temp = False
If path <> "" Then
If fs.FileExists(path) Then
Dim Message,Stm,Attachment
Dim SaveFile
'第一引数をemlファイルとして読込
Set Message = CreateObject("CDO.Message")
Set Stm = CreateObject("ADODB.Stream")
'emlファイルを開く
Stm.Open
Stm.LoadFromFile path
Message.DataSource.OpenObject Stm, "_Stream"
For Each Attachment In Message.Attachments
SaveFile = fs.GetAbsolutePathName(fs.BuildPath(outpath, Attachment.FileName))
objLogFile.Write 1, "SaveFile : " & SaveFile
Attachment.saveToFile SaveFile
Next
Stm.Close
End If
End If
SaveAttachment = temp
End Function
End Class