Originally posted by Mark Sreeves
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")

oNameSpace.Logon "MyProfile", , False, True

Set oFolder = oNameSpace.GetDefaultFolder(olFolderInbox)

For Each oMailItem In oFolder.Items
  With oMailItem
    
    If oMailItem.UnRead = True Then
    
    If oMailItem.Attachments.Count > 0 Then
      oMailItem.Attachments.Item(1).SaveAsFile "C:\Temp\OutlookAttachments\" & _
      oMailItem.Attachments.Item(1).Filename
   End If
  
   End If
End With
Next oMailItem
Set oMailItem = Nothing
Set oFolder = Nothing
Set oNameSpace = Nothing
Set oApp = Nothing
End Sub