this uses the Outlook 8.0 object libriary:
Code:Sub ReadEmail() Dim oApp As Outlook.Application Dim oNameSpace As Outlook.NameSpace Dim oFolder As Outlook.MAPIFolder Dim oMailItem As Object Dim sMessage As String Set oApp = New Outlook.Application Set oNameSpace = oApp.GetNamespace("MAPI") Dim Filename As String Dim fnum As Byte oNameSpace.Logon "MyProfile", , False, True Set oFolder = oNameSpace.GetDefaultFolder(olFolderInbox) For Each oMailItem In oFolder.Items With oMailItem If oMailItem.UnRead = True Then If UCase(oMailItem.Subject) = "WHATEVER" Then Debug.Print oMailItem.Body 'create a unique file name Filename = "C:\MailText" & Format(Now, "yymmddhhnnss") & ".txt" fnum = FreeFile Open Filename For Binary As fnum Put #fnum, , oMailItem.Body Close fnum End If End If End With Next oMailItem Set oMailItem = Nothing Set oFolder = Nothing Set oNameSpace = Nothing Set oApp = Nothing End Sub




Reply With Quote