All,
   I have a procedure which checks the users Outlook Inbox for the
existance of an email from a specific address. If one is found, a question
is asked to the user asking if they wish to allow the database to save the
attachment and import the data. The reason for this is that the network is
extremely slow and the import takes several minutes to complete. During the
import, the database looks as though it is not responding. Giving them the
option to cancel the import stops them being interrupted whilst working.

My problem is that I wish to give the users another option which if they
select it, will import however many mails exist in their Inbox without
prompting them each time it finds a specific mail. This would be the case if
they do not intend to use the database for some time.

I'm a Newbie at VBA so forgive me if it's messy :o(

My code is as follows:

Public Sub CheckInbox(SavePath As String, StatusPart As Integer)
On Error GoTo AutoImportError
Dim mliNew As MailItem
Dim Ns As NameSpace
Dim oOutlook As Outlook.Application
Dim QuestionAuto As String

   Set oOutlook = New Outlook.Application
   Set Ns = oOutlook.GetNamespace("MAPI")
   Set mfrInbox = Ns.GetDefaultFolder(olFolderInbox)

    With mfrInbox
    Forms!frm_switchboard!txt_InboxCount = .Items.Count
       DoEvents

       If .Items.Count = 0 Then 'No mails in Inbox
       Forms!frm_switchboard!txt_InboxCount = .Items.Count
             Exit Sub 'Quit the routine if no mails exist
       Else

           .Items.Sort "Received", True
           'Go through every email in the Inbox
           For Each mliNew In .Items

               If mliNew.SenderName = "AS400 George" Then 'Mail is one
we're looking for

'A mail is found, check with the user if they want to import it!!!!
QuestionAuto = MsgBox("Intake Manager has found an email in your Inbox which
it needs to import!" & vbNewLine & _
           "The database will try now attempt to import the file" & vbCrLf
& vbCrLf & "This may cause the database to stop responding for several
minutes." & vbNewLine & _
           "Do you want it to continue?", vbYesNo + vbQuestion, "Import
Check")

   If QuestionAuto = vbNo Then
           ImportTimer = 0 'Reset the timer
               Exit Sub
                    End If

                   mliNew.Attachments.Item(1).SaveAsFile SavePath 'Save the
attachment
                   ImportRatio

                   If Not IsNull(DLookup("psku", "tbl_tmp_ratio")) Then
                       MsgBox "During the Auto Import proceedure, a ratio
sku was found in the text file" & vbCrLf & _
                       "that doesn't exist in the database!" & vbCrLf & _
                       "Please update the ratio sku information now!!" &
vbCrLf & vbCrLf & _
                       "The database will attempt the import again within
the hour", vbCritical, "New Ratio Sku"

       DoCmd.SetWarnings False
       DoCmd.RunSQL "delete * from tbl_tmp_ratio;" 'Clear the temp ratio
table
       DoCmd.SetWarnings True

                   Exit Sub
                           End If

                   ImportNewDay 'Run the Import proceedure
                   mliNew.Delete 'Delete the mail

               End If
           Next  'Move onto next mail in Inbox

       End If
   End With

Main_Exit:
  Set mliNew = Nothing
  Set Ns = Nothing
  Set oOutlook = Nothing
  Exit Sub

AutoImportError:
   MsgBox "An error has occurred with the following details:" & vbNewLine &
_
   "Description: " & Err.Description & vbNewLine & _
   "Error Number: " & Err.Number & vbNewLine & vbNewLine & _
   "Please report these details to the database administrator"
   Resume Main_Exit
End Sub