Code For Excel And Outlook Blog

Private WithEvents QueueInbox As Outlook.Items
Dim bWasPosted As Boolean

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

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

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