Public Function GetNewMessages()
On Error GoTo Err_GetNewMessages
'declare and open instance of MS Outlook
Dim olOutlook As New Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olFolders As Outlook.MAPIFolder
Dim olInbox As Outlook.MAPIFolder
Dim olItems As Outlook.Items
'need to declare the following as object instead of Outlook.MailItem
'to allow for meeting requests, etc. that we may find in the folder
Dim olInboxItem As Object
'Dim olInboxItem As Outlook.MailItem
Dim olAttachment As Outlook.Attachment
Dim strPSTName As String, strFolderName As String
Dim strSender As String, strSubject As String, strPriority As String
Dim strMessage As String, strAttach As String
Dim intCounter As Integer, intNewMessages As Integer
'assign name of outlook PST file or mail box we want to use
'to string variable
strPSTName = "Mailbox - Gang, OM"
'name of folder in PST file or mail box we want to work with
strFolderName = "Inbox"
'set object Outlook NameSpace
Set olNS = olOutlook.GetNamespace("MAPI")
'set object NameSpace Folders for PST file
Set olFolders = olNS.Folders(strPSTName)
'set object mail folder for PST file
Set olInbox = olFolders.Folders(strFolderName)
'set object messages in folder
Set olItems = olInbox.Items
'loop through list of mail messages
For intCounter = 1 To olItems.Count
Set olInboxItem = olItems(intCounter)
If olInboxItem.UnRead Then
If olInboxItem.Attachments.Count <> 0 Then
Set olAttachment = olInboxItem.Attachments(1)
strAttach = olAttachment.FileName
End If
'intNewMessages = intNewMessages + 1
strSender = olInboxItem.SenderEmailAddress
strSubject = olInboxItem.Subject
strPriority = olInboxItem.Importance
strMessage = "Subject = " & strSubject
strMessage = strMessage & vbCrLf & "Sender = " & strSender
strMessage = strMessage & vbCrLf & "Priority = " & strPriority
strMessage = strMessage & vbCrLf & "Attachment = " & strAttach
MsgBox strMessage, , "New Mail"
End If
Next intCounter
'MsgBox "Unread Messages: " & intNewMessages, , "Here You Go!"
Exit_GetNewMessages:
'clear object variables
Set olAttachment = Nothing
Set olInboxItem = Nothing
Set olItems = Nothing
Set olInbox = Nothing
Set olFolders = Nothing
Set olNS = Nothing
Set olOutlook = Nothing
Exit Function
Err_GetNewMessages:
MsgBox Err.Number & ", " & Err.Description, , "Error"
Resume Exit_GetNewMessages
End Function
|