Simple VB Code to Process Your Outlook E-mails

• Download source - 1.44 KB

Accessing Your Office E-mail

Sometimes you may have to access your office e-mail when you are in other places and cannot logon (remotely). If you are using Microsoft Outlook, then it is pretty easy to access your e-mail remotely. In this article, I am including a simple VB subroutine that can be installed as a macro in Outlook. It helps you with the following:

1. Gets a list of all messages in one of your Outlook folders.
2. Forwards all messages in your Outlook folder to your other e-mail account.
3. Deletes all messages in your Outlook folder whose subject line contains a string you provided.

Here is what you need to do to use it:

• Copy the source code from the download file and use it to create a macro in Outlook.
• Adjust Outlook security to enable your macro.
• Create a new rule in Outlook that invokes this macro whenever an e-mail from your outside account arrives (such as from YourName@yahoo.com). Please note that you should not invoke this macro for all incoming messages, otherwise anyone will be able to access your e-mail.
• Leave Outlook running. The macro will not work when you shutdown Outlook.
• Send a request as described below from your outside account (YourName@yahoo.com) to your Outlook account.

Note: If you are using Outlook 2003, then there will be an annoying dialog box asking for your confirmation whenever your macro is invoked. In that case, you have to either write or download a program to get rid of the dialog box.

The Request Message

The subject line of the request message indicates request type. It has to end with number 31415926. The body of the request message provides additional parameters, such as parent folder name, child folder name, and subject string.

1. Get Message List Request: The subject line has to be "GetMsgList31415926", the message body is ParentFolderName\ChildFodlerName. After sending this request, you will receive a message listing all of your Outlook e-mails in the specified child folder. The list will contain message subject, sender address, and received time.
2. Get Messages Request: The subject line has to be "GetMsgs31415926", the message body is ParentFolderName\ChildFodlerName. After sending this request, all your Outlook e-mails in the specified child folder will be forwarded to you.
3. Delete Messages Request: The subject line has to be "DeleteMsgs31415926", the message body is ParentFolderName\ChildFodlerName\SubjectString. After sending this request, all of your Outlook e-mails in the specified child folder that contain the specified SubjectString in message subject will be deleted. If you do not specify a SubjectString in your request, then all messages in the child folder will be deleted.
4. Get Folder List Request: The subject line has to be "GetFolderList31415926", the message body is ignored. After sending this request, you will receive a message that contains all of your Outlook folders (parent folders plus child folders). This request is intended to help you with sending the above three requests.

Note: If your Outlook folder structure has more than two layers, then you need to modify the VB code to make it work.

The Code with Comments

Sub ProcessMsg(msg As MailItem)
On Error GoTo TheEnd
    ' get sender e-mail address
    Dim msgSender As String
    msgSender = msg.SenderEmailAddress
    ' get message subject as type string
    Dim msgType As String
    msgType = UCase(Trim(msg.subject))
    ' get message body as additional parameters
    Dim params() As String
    params = Split(msg.Body, "\")
    ' check message type to see if we need to process
    If Right(msgType, 8) = "31415926" Then
        ' delete the message, we have no use for it now
        msg.Delete
        ' get application object
        Dim app As Application
        Set app = CreateObject("Outlook.Application")
        ' get name space object
        Dim ns As NameSpace
        Set ns = app.GetNamespace("MAPI")
        ' process "Get Messages" request
        If msgType = "GETMSGS31415926" Then
            If UBound(params) < 1 Then GoTo TheEnd
            ' params(0) is the parent folder name
            ' params(1) is the child folder name
            Dim i As MAPIFolder
            For Each i In ns.Folders
                If UCase(Trim(i.Name)) = UCase(Trim(params(0))) Then
                    Dim j As MAPIFolder
                    For Each j In i.Folders
                        If UCase(Trim(j.Name)) = UCase(Trim(params(1))) Then
                            Dim fwd As MailItem
                            Dim k As MailItem
                            For Each k In j.Items
                                ' forward all messages in child folder to
                                ' sender of the special message
                                Set fwd = k.Forward
                                fwd.To = msgSender
                                fwd.Send
                            Next
                        End If
                    Next
                End If
            Next
        ' process "Get Message List" request
        ElseIf msgType = "GETMSGLIST31415926" Then
            If UBound(params) < 1 Then GoTo TheEnd
            ' create reply message
            Dim listMsgs As MailItem
            Set listMsgs = app.CreateItem(olMailItem)
            listMsgs.To = msgSender
            listMsgs.subject = "Outlook message list"
            ' params(0) is the parent folder name
            ' params(1) is the child folder name
            Dim msgList As String
            msgList = vbCrLf
            Dim r As MAPIFolder
            For Each r In ns.Folders
                If UCase(Trim(r.Name)) = UCase(Trim(params(0))) Then
                    Dim s As MAPIFolder
                    For Each s In r.Folders
                        If UCase(Trim(s.Name)) = UCase(Trim(params(1))) Then
                            Dim c As Integer
                            c = 1
                            Dim t As MailItem
                            For Each t In s.Items
                                ' msgList is the body of the listMsgs message, 
                                ' it will be the list of
                                ' all messages in requested child folder
                                msgList = msgList & vbCrLf & c & vbCrLf & " " & _
				t.subject & vbCrLf & " " & t.SenderEmailAddress & _
				vbCrLf & " " & t.ReceivedTime
                                c = c + 1
                            Next
                        End If
                    Next
                End If
            Next
            listMsgs.Body = msgList
            listMsgs.Send
        ' process "Delete Messages" request
        ElseIf msgType = "DELETEMSGS31415926" Then
            If UBound(params) < 1 Then GoTo TheEnd
            ' params(0) is the parent folder name
            ' params(1) is the child folder name
            ' params(2) is the string to filter messages to be deleted
            Dim filter As String
            If UBound(params) = 2 Then filter = UCase(Trim(params(2))) Else filter = ""
            Dim x As MAPIFolder
            For Each x In ns.Folders
                If UCase(Trim(x.Name)) = UCase(Trim(params(0))) Then
                    Dim y As MAPIFolder
                    For Each y In x.Folders
                        If UCase(Trim(y.Name)) = UCase(Trim(params(1))) Then
                            Dim z As MailItem
                            ' delete all messages in the child folder
                            If filter = "" Then
                                Set z = y.Items.GetLast
                                While Not z Is Nothing
                                    z.Delete
                                    z = y.Items.GetLast
                                Wend
                            ' delete only messages in the child folder
                            ' whose subject line contains the special string
                            Else
                                For Each z In y.Items
                                    If InStr(UCase(Trim(z.subject)), filter) > 0 Then
                                        z.Delete
                                    End If
                                Next
                            End If
                        End If
                    Next
                End If
            Next
        ' process "Get Folder List" request
        ElseIf msgType = "GETFOLDERLIST31415926" Then
            ' create reply message
            Dim listFolders As MailItem
            Set listFolders = app.CreateItem(olMailItem)
            listFolders.To = msgSender
            listFolders.subject = "Outlook folder list"
            Dim folderList As String
            folderList = vbCrLf
            Dim m As MAPIFolder
            For Each m In ns.Folders
                folderList = folderList & vbCrLf & m.Name
                Dim n As MAPIFolder
                For Each n In m.Folders
                    ' folderList is the body of the listFolders message, it will be the
                    ' list of all your Outlook folders and their child folders
                    folderList = folderList & vbCrLf & "    " & n.Name
                Next
            Next
            listFolders.Body = folderList
            listFolders.Send
        End If
    End If
TheEnd:
End Sub

History

• 04/15/2010: Initial post