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(Save Path As String, StatusPart As Integer)
On Error GoTo AutoImportError
Dim mliNew As MailItem
Dim Ns As NameSpace
Dim oOutlook As Outlook.Applica tion
Dim QuestionAuto As String
Set oOutlook = New Outlook.Applica tion
Set Ns = oOutlook.GetNam espace("MAPI")
Set mfrInbox = Ns.GetDefaultFo lder(olFolderIn box)
With mfrInbox
Forms!frm_switc hboard!txt_Inbo xCount = .Items.Count
DoEvents
If .Items.Count = 0 Then 'No mails in Inbox
Forms!frm_switc hboard!txt_Inbo xCount = .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.SenderNa me = "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.Attachme nts.Item(1).Sav eAsFile 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.SetWarnin gs False
DoCmd.RunSQL "delete * from tbl_tmp_ratio;" 'Clear the temp ratio
table
DoCmd.SetWarnin gs 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 &
_
"Descriptio n: " & Err.Description & vbNewLine & _
"Error Number: " & Err.Number & vbNewLine & vbNewLine & _
"Please report these details to the database administrator"
Resume Main_Exit
End Sub
