組み込み系プログラマの覚書

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

• emlファイルから添付ファイルを抽出するスクリプト
• Saving Messages into ADO Stream Objects
• SaveToFile Method
• SaveToFile Method