[navy]Sub [/navy] CheckInbox()
On [navy]Error Goto[/navy] CheckInbox_err
Const cSaveFileFolder [navy]As String[/navy] = "C:\"
[navy]Dim[/navy] appOutlook [navy]As Object[/navy], objNameSpace [navy]As Object[/navy]
[navy]Dim[/navy] fldDefault [navy]As Object[/navy], objMailItem [navy]As Object[/navy]
[navy]Dim[/navy] varMailAttachements [navy]As Variant[/navy]
[navy]Dim[/navy] blnCloseOutlook [navy]As Boolean[/navy]
[navy]Dim[/navy] intMailAttachement [navy]As Integer[/navy]
[navy]Dim[/navy] strSaveFileName [navy]As String[/navy]
[green]'Get the current instance of Outlook, or create a new one[/green]
Set appOutlook = GetObject(, "Outlook.Application")
[navy]If[/navy] Err.Number <> 0 [navy]Then[/navy]
Set appOutlook = CreateObject("Outlook.Application")
blnCloseOutlook = [navy]True[/navy]
[navy]End If[/navy]
[green]'Get the default Inbox[/green]
Set objNameSpace = appOutlook.GetNamespace("MAPI")
Set fldDefault = objNameSpace.GetDefaultFolder(6) [green]'olFolderInbox[/green]
[green]'Loop through all the items in the Inbox[/green]
[navy]For Each[/navy] objMailItem In fldDefault.Items
[navy]If[/navy] objMailItem.Class = 43 [navy]Then[/navy] [green]'olMail[/green]
[green]'Test For the recipient here[/green]
Debug.Print objMailItem.SenderName
[green]'Grab the Attachements collection[/green]
Set varMailAttachements = objMailItem.Attachments
[green]'Check If there are attachements[/green]
[navy]If[/navy] varMailAttachements.Count <> 0 [navy]Then[/navy]
[green]'Loop through the attachements[/green]
[navy]For[/navy] intMailAttachement = 1 [navy]To[/navy] varMailAttachements.Count
[green]'Save the attachement, append Date/time stamp in[/green]
[green]'case attachements have the same name[/green]
strSaveFileName = cSaveFileFolder & _
Format(objMailItem.SentOn, "yyyy-mm-dd_hhnn_") & _
varMailAttachements(intMailAttachement).FileName
varMailAttachements(intMailAttachement).SaveAsFile strSaveFileName
[navy]Next[/navy] intMailAttachement
[navy]End If[/navy]
[navy]End If[/navy]
[navy]Next[/navy] objMailItem
CleanUP:
Set varMailAttachements = [navy]Nothing[/navy]
Set fldDefault = [navy]Nothing[/navy]
Set objNameSpace = [navy]Nothing[/navy]
[navy]If[/navy] blnCloseOutlook [navy]Then[/navy]
appOutlook.Quit
[navy]End If[/navy]
Set appOutlook = [navy]Nothing[/navy]
[navy]Exit Sub [/navy]
CheckInbox_err:
Debug.Print Err.Number, Err.Description
Resume [navy]Next[/navy]
[navy]End Sub [/navy]