Hey Jack,
I couldn't get your could to work but I did get the following code to work.
**************************************************
Dim oSession As MAPI.Session
Dim oMessage As MAPI.Message
Dim oMessages As MAPI.Messages
Dim oInbox As MAPI.Folder
Dim oAttachment As MAPI.Attachment
Dim oAttachments As MAPI.Attachments
Private Sub Form_Load()
Set oSession = CreateObject("MAPI.Session")
strProfileInfo = "server" & vbLf & "user"
oSession.Logon NewSession:=True, NoMail:=False, showDialog:=False, ProfileInfo:=strProfileInfo
Set oInbox = oSession.Inbox
Set oMessages = oInbox.Messages
Dim objItem As Object
Dim dteCreateDate As Date
Dim strSubject As String
Dim strItemType As String
Dim strBody As String
Dim intCounter As Integer
For A = 1 To oMessages.Count
Set oMessage = oMessages.Item(A)
With oMessage
If LCase(.Subject) = "subject" Then
Set oAttachments = oMessage.Attachments
dteCreateDate = .TimeCreated
strSubject = .Subject
strItemType = TypeName(oMessage)
PathString = "D:\My Documents\Email Reader\"
For I = 1 To oAttachments.Count
Set oAttachment = oAttachments.Item(I)
PathString = PathString & oAttachment.Name
oAttachment.WriteToFile PathString
Next
Debug.Print vbTab & "Item #" & intCounter & " - " _
& strItemType & " - created on " _
& Format(dteCreateDate, "mmmm dd, yyyy hh:mm am/pm") _
& vbCrLf & vbTab & vbTab & "Subject: '" _
& strSubject & "'" & vbCrLf _
& strBody & vbCrLf
End If
End With
Next
End Sub
Private Sub Form_Terminate()
On Error Resume Next
If Not (oSession Is Nothing) Then
oSession.Logoff
Set oSession = Nothing
End If
End Sub