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




Reply With Quote