Solved

Extract sender,subject,priority,attachment from ms outlook using vba

Posted on 2008-06-11
9
1,316 Views
Last Modified: 2009-04-12
I would like to  extract  sender,subject,priority,attachment from ms outlook form unread emails from with ms access.Thanks.
0
Comment
Question by:wwstudioinc
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
9 Comments
 
LVL 28

Expert Comment

by:omgang
ID: 21764755
You can start with this Q that I answered earlier today.  It will find the unread messages in the specified mailbox and folder.

http://www.experts-exchange.com/Microsoft/Development/MS_Access/Q_23475983.html

OM Gang
0
 

Author Comment

by:wwstudioinc
ID: 21764868
om gang that's ive used but i need to extract the if the email has an attachment and priority
0
 
LVL 28

Expert Comment

by:omgang
ID: 21764927
I modified it a bit for you.
OM Gang
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 strPSTName As String, strFolderName As String
    Dim strSender As String, strSubject As String, strPriority As String
    Dim strMessage 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
            '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
            MsgBox strMessage, , "New Mail"
        End If
        
    Next intCounter
    
    'MsgBox "Unread Messages:  " & intNewMessages, , "Here You Go!"
 
Exit_GetNewMessages:
        'clear object variables
    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

Open in new window

0
Back Up Your Microsoft Windows Server®

Back up all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

 
LVL 28

Accepted Solution

by:
omgang earned 500 total points
ID: 21765000
Added conditional to check for attachment and get the attachment name in the output message.  Try this; it should get you close.  You can add a conditional to check if the priority is not equal to 1 (normal).  No time right now to work on getting the attachment saved somewhere.  Maybe tomorrow if you haven't figured it out by then.
OM Gang
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

Open in new window

0
 
LVL 28

Assisted Solution

by:omgang
omgang earned 500 total points
ID: 21769504
Yet another revision.  Checks for new (unread) messages, if they have attachment checks to see if Importance (Priority) is not equal 1 (other than normal), if all is True then saves a copy of the attachment to the specified directory (strSaveToPath) and displays a message to the user.

You can change the assignment of strSaveToPath to an Input box function if you want to provide the user with the option of choosing where to save the attachment.

OM Gang
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, strSaveToPath 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
                If olInboxItem.Importance <> 1 Then
                    Set olAttachment = olInboxItem.Attachments(1)
                    strAttach = olAttachment.FileName
                    strSaveToPath = "c:\temp\"
                    olAttachment.SaveAsFile strSaveToPath & strAttach
                    
                    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 _
                    & " saved to " & strSaveToPath
                    MsgBox strMessage, , "New Mail"
                End If
            End If
            'intNewMessages = intNewMessages + 1
        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

Open in new window

0
 

Author Comment

by:wwstudioinc
ID: 21772903
OM Gang they both worked find but i  am getting the annoying "another program" etc. screen but that's another question
0
 
LVL 28

Expert Comment

by:omgang
ID: 21773208
Unfortunately that is something you are not going to be able to avoid.  It's possible to send e-mail and avoid the Outlook Security message (by using CDO or Outlook Redemption or other tools) but what you are doing is directly accessing Outlook mail folders.  The Outlook security prompt is designed to alert you when another program attempts to access these folders.  I've used third party tools like MapiLab's Outlook Security and have heard good thinkgs about a program named Click Yes, both of which clear the message for you so it does not require user intervention.  Perhaps something you can investigate.

OM Gang
0
 

Author Comment

by:wwstudioinc
ID: 21773424
thanks for the information
0
 
LVL 1

Expert Comment

by:aballeras
ID: 24332817
hi omg gang,

your code has help me, i just want to thank you for the information.

thank you very much.
0

Featured Post

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

It’s the first day of March, the weather is starting to warm up and the excitement of the upcoming St. Patrick’s Day holiday can be felt throughout the world.
Did you know that more than 4 billion data records have been recorded as lost or stolen since 2013? It was a staggering number brought to our attention during last week’s ManageEngine webinar, where attendees received a comprehensive look at the ma…
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

749 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question