Mike,
Here is a function that I have used to check to see if there are any emails
in a specific folder:
'***Start Code****
'Variables declared
Dim ol As Outlook.Application, olns As Outlook.NameSpace
Dim InBoundFolder As Outlook.mapiFolder, InBoundInBox As Outlook.mapiFolder
Dim cntr, NxtCntr
Dim FileNamePrefix As String
Dim Emails As Outlook.Items
Dim AttachedFiles As Outlook.Attachments
Dim objAtt As Outlook.Attachment
Dim varAttachmentsFound As Boolean
Public dhCSXTFileExists, dhCPRSFileExists As Boolean
Dim varCSXTFile As String
Dim varCPRSFile As String, varIsRoadName As String
Dim varCSXTFileName, varCPRSFileName As String
Function ChkForEmail()
Set ol = New Outlook.Application
Set olns = ol.GetNamespace("MAPI")
Set InBoundFolder = olns.Folders("Mailbox - YourMailBoxNameHere")
Set InBoundInBox = InBoundFolder.Folders("Inbox")
If InBoundInBox Is Nothing Then Exit Function
If InBoundInBox.Items.Count = 0 Then
ChkForEmail = False
Else
ChkForEmail = True
End If
'discontinue use of objects
Set objAtt = Nothing
Set AttachedFiles = Nothing
Set Emails = Nothing
Set InBoundInBox = Nothing
Set InBoundFolder = Nothing
Set olns = Nothing
Set ol = Nothing
End Function
'****End of Function Code****
Next, here is a function that I used to save the attached delimited text
files based on the value of the first four characters in the name of the
attachment. (we could have one file format of incomming data from one source
and a different file format type from a different source.)
Function FindAndSaveEmailAttachments()
Set ol = New Outlook.Application
Set olns = ol.GetNamespace("MAPI")
Set InBoundFolder = olns.Folders("Mailbox - YourMailboxNameHere")
Set InBoundInBox = InBoundFolder.Folders("Inbox")
If InBoundInBox Is Nothing Then Exit Function
'get the count of the new emails
'varEmailCnt = InBoundInBox.Items.Count
'process each email and save all attachments
Set Emails = InBoundInBox.Items
For cntr = 1 To InBoundInBox.Items.Count
'if there are attachments, save each attachment
If Not Emails.Item(cntr).Attachments Is Nothing Then
Set AttachedFiles = Emails.Item(cntr).Attachments
If AttachedFiles.Count > 0 Then
varAttachmentsFound = True
For NxtCntr = 1 To AttachedFiles.Count
Set objAtt = AttachedFiles.Item(NxtCntr)
FileNamePrefix = Left(objAtt.fileName, 4)
'if the attachment is from the CTSX it will have a prefix of
"ABCD"
If FileNamePrefix = "ABCD" Then
objAtt.SaveAsFile varCSXTFilePath & objAtt.fileName
Else
objAtt.SaveAsFile varCPRSFilePath & objAtt.fileName
End If
Next NxtCntr
Else
varAttachmentsFound = False
End If
Else
varAttachmentsFound = False
End If
Next cntr
'delete all of the emails
'this needs to delete each item in reverse order
For cntr = InBoundInBox.Items.Count To 1 Step -1
InBoundInBox.Items(cntr).Delete
Next cntr
'discontinue use of objects
Set objAtt = Nothing
Set AttachedFiles = Nothing
Set Emails = Nothing
Set InBoundInBox = Nothing
Set InBoundFolder = Nothing
Set olns = Nothing
Set ol = Nothing
'if attachments were found, import the data from the saved attachments
If varAttachmentsFound = True Then
ImportNewLogs
Forms![frmInBoundLogs].SetFocus
With Forms![frmInBoundLogs]![lstInBound]
.SetFocus
.Requery
.Value = Null
End With
Forms![frmInBoundLogs]![cmdGetNewInBound].Enabled = False
End If
End Function
I hope you can make some sence of all this and that you are able to use it.
