Run Macro when an Email is received

[Hudas]

Hello...

My outlook profile set up, but aside from that I have another profile which is a Group Mail Box added to me. My question is how do I run a macro when we received an email to the group mailbox. We are using an exchange server.

I've tried the Application_NewMailEx but its just firing when I received an email into my own profile.

Thank you

Hudas

 

[Diane Poremsky]

Use an itemadd macro and watch the managed mailbox's inbox. You might need to use the GetFolderPath function too.

http://www.slipstick.com/developer/move-messages-cc-address/ - has a sample itemadd macro but it uses the default inbox. you need to change the folder in the application startup macro.

http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/

 

[Hudas]

Hi Diane,

Again Thank you very much! You've been a great help!!!

Kindly see below working code:

It fires whenever a new email is received in our Group MailBox.

Private WithEvents olInboxItems As Items 
 
Private Sub Application_Startup()
 Dim objNS As NameSpace
 Set objNS = Application.Session
 Set olInboxItems = GetFolderPath("My Outlook name here\Inbox").Items
 Set objNS = Nothing 
 
End Sub 
 
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
 'On Error Resume Next
 Dim strID As String
   Dim objMail As Outlook.MailItem
  
   strID = Item.EntryID
   Set objMail = Application.Session.GetItemFromID(strID)
 
   MsgBox "Email Received" 
 
'   If objMail.CC = "alias" Then 
 
'      objMail.Move Session.GetDefaultFolder(olFolderInbox).Folders("Inbox") 
 
'   End If 
 
Set objMail = Nothing 
 
End Sub 
 
Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
   Dim oFolder As Outlook.Folder
   Dim FoldersArray As Variant
   Dim i As Integer
      
   On Error GoTo GetFolderPath_Error
   If Left(FolderPath, 2) = "\\" Then
       FolderPath = Right(FolderPath, Len(FolderPath) - 2)
   End If
   'Convert folderpath to array
   FoldersArray = Split(FolderPath, "\")
   Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
   If Not oFolder Is Nothing Then
       For i = 1 To UBound(FoldersArray, 1)
           Dim SubFolders As Outlook.Folders
           Set SubFolders = oFolder.Folders
           Set oFolder = SubFolders.Item(FoldersArray(i))
           If oFolder Is Nothing Then
               Set GetFolderPath = Nothing
           End If
       Next
   End If
   'Return the oFolder
   Set GetFolderPath = oFolder
   Exit Function
       
 
GetFolderPath_Error:
   Set GetFolderPath = Nothing
   Exit Function 
 
End Function

I have one more question though.. will the code run if I have my outlook close?

Thank you very much!!!

 

[Diane Poremsky]

No, macros only run when outlook is open.

 

[Diane Poremsky]

Dang forum. It keep reposting my messages. ;( ;(