Solved

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

Posted on 2008-06-11
9
1,306 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
  • 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
 
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
Backup Your Microsoft Windows Server®

Backup 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

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
TRIM a textbox value MS Access 10 23
Direct Mail software 4 42
Running sum query 6 30
Improving performance of a query that uses a subquery 9 30
In Debugging – Part 1, you learned the basics of the debugging process. You learned how to avoid bugs, as well as how to utilize the Immediate window in the debugging process. This article takes things to the next level by showing you how you can us…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
Familiarize people with the process of retrieving data from SQL Server using an Access pass-thru query. Microsoft Access is a very powerful client/server development tool. One of the ways that you can retrieve data from a SQL Server is by using a pa…
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…

911 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

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now