Hands Off That Email Attachment!

April 14, 2008 – 5:49 pm by JP

About halfway down the Outlook page, there is some VBA code for opening an Excel workbook attached to an email, running a macro on it, then cleaning up and moving the email to another folder.

Here is some more sample code to make your macro even more intelligent. This code opens the attachment, then scans through the spreadsheet looking for an error condition. If the error condition is met, an email is generated to another mailbox, as an alert, and the email is left in the Inbox to be looked at by a human. If the error condition isn’t met, there’s no reason to look at the email, so it gets marked as read and moved to an archive folder.

If you are like me, then your time is valuable. You don’t want to spend time looking at emails that you don’t need to work on. This code lets me focus on high-value activities while using Outlook’s built-in capabilities to ignore the spreadsheets that don’t need personal attention.

First you want to open ThisOutlookSession and paste this event code:


Private WithEvents QueueInbox As Outlook.Items
Dim bWasPosted As Boolean

Really you can use anything in place of “QueueInbox”, but I use something that will relate to the task so I can easily identify what the code is doing. The boolean variable is put in the global section because we are using it in one procedure (the mail sending sub) and checking the value in another sub.

Now you need to tell Outlook to monitor your chosen Inbox for new items. This code placed in the Application_Startup event will do that.


Set QueueInbox = objNS.Folders("Mailbox - My Mailbox Name").Folders("Inbox").Items

Replace “My Mailbox Name” with the name of the mailbox you want to check. For example, if I were running this on my own Inbox, the code would be


Set QueueInbox = objNS.Folders("Mailbox - Jimmy Pena").Folders("Inbox").Items

If you don’t have an Application_Startup event, just put “Private Sub Application_Startup()” right above the Set statement, and “End Sub” right below it.

Now on to the real work. When a new item is added to the Inbox we selected, it saves and opens the attachment, checks to make sure everything is OK, and if so, moves the email to an archive folder. Don’t forget to set a reference to the Excel object library (see binding page for assistance).

Of course I make some assumptions here, which you might want to change. For example, the emails we are checking have a known sender and subject, which was pre-arranged. Also, they always have one .xls attachment. If you can agree on a system like this, you’ll be able to use Outlook code to automate some pretty boring processes.


Private Sub QueueInbox_ItemAdd(ByVal Item As Object)

Dim objNS As Outlook.NameSpace
Dim ArchiveFolder As Outlook.MAPIFolder
Dim Msg As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Const attPath As String = “C:\”
Dim colACount As Long
Dim colGCount As Long
Dim cell As Excel.Range
Dim MyBook As Excel.Workbook
Dim MySheet As Excel.Worksheet
Dim colARange As Excel.Range
Dim colGRange As Excel.Range
Dim bBadCount As Boolean

bWasPosted = False
bBadCount = False

Set objNS = GetNamespace(”MAPI”)
' the archive folder we are moving emails to
Set ArchiveFolder = objNS.Folders(”Mailbox - My Mailbox Name”)._
Folders(”Inbox”).Folders(”Archive”)

' check to make sure we are looking at a mailitem
If TypeOf Item Is Outlook.MailItem Then
  If (Item.SenderName = “MySender@somewhere.com”) And _
  (Item.Subject = “Attachment You Requested”) Then
    ' obj ref to msg
    Set Msg = Item
    ' get attachment
    Set myAttachments = Msg.Attachments
    Att = myAttachments.Item(1).DisplayName
    myAttachments.Item(1).SaveAsFile attPath & Att

    ' open workbook and check for errors
    Set XLApp = New Excel.Application
    Set MyBook = XLApp.Workbooks.Open(attPath & Att)
    Set MySheet = MyBook.Sheets(1)

    ' check count of columns A & G to make sure they match
    ' at this point you could do anything you want to the workbook, as if you
    ' were in the Excel VBE
    Set colARange = MySheet.Range(”A2:A5000″)
    Set colGRange = MySheet.Range(”G2:G5000″)

    colACount = colARange.SpecialCells(xlCellTypeConstants).Count
    colGCount = colGRange.SpecialCells(xlCellTypeConstants).Count

    If colACount <> colGCount Then
    ' we found an error!
      MyBook.Close False
      ' call other macro and pass email to it as an argument,
      ' so we can use some properties of the current mailitem
      Call PostMsg(Msg)
      bBadCount = True
    End If

  ' bBadCount is a boolean variable checking if the match count
  ' caused an error, we skip further checks if that is the case
  ' because we only need one error

  If bBadCount = False Then
  ' the count matched, but maybe we have invalid values
    For Each cell In colGRange.SpecialCells(xlCellTypeConstants, 2)
      If (cell.Value = “#N/A”) Then
        MyBook.Close False
        Call PostMsg(Msg)
      End If
    Next cell
  End If

  ' at this point, if PostMsg was called,
  ' bWasPosted would be True

  If bWasPosted = False Then
  ' we didn’t post a msg to MyInbox, so there must be
  ' nothing wrong with the attachment, so we can move it
    With Msg
      .UnRead = False
      .Move ArchiveFolder
    End With
  End If
 End If
End If

ExitProc:
On Error Resume Next
XLApp.DisplayAlerts = False
XLApp.Workbooks.Close
XLApp.DisplayAlerts = True
Kill attPath & Att
XLApp.Quit
On Error GoTo 0
Set ArchiveFolder = Nothing
Set objNS = Nothing

End Sub


Sub PostMsg(Msg As Outlook.MailItem)
'
' sub that actually puts the email in the inbox
'
Dim NotifyMsg As Outlook.MailItem
Dim MyFolder As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace
Dim strMsg As String

Set objNS = GetNamespace(”MAPI”)
Set MyFolder = objNS.Folders(”Mailbox - Jimmy Pena”).Folders(”Inbox”)

Set NotifyMsg = MyFolder.Items.Add(olMailItem)

With NotifyMsg
  .Subject = “Invalid Attachment Received”
  .Importance = olImportanceHigh
  .To = “jpena@myemail.com”

  strMsg = “The following message was received by Queue Inbox on ” & Msg.ReceivedTime & “:”
  strMsg = strMsg & vbCr & vbCr & Msg.Body
  strMsg = strMsg & vbCr & vbCr & “This is an automatically generated message.”
  .Body = strMsg
  .UnRead = True
End With

bWasPosted = True

NotifyMsg.Send

End Sub

After implementing this code, you’ll see that it checks incoming mail items for the ones with the appropriate sender and subject, browses through the attachment for errors, and sends an email to your Inbox of choice if an error is found. If no error is found, it quietly marks the email as read and moves it to another folder.

Now, hands off!

Enjoy,
JP

If you enjoyed this page, share it!