title: Send email to all contacts in Outlook address book when a new email received (VB)
body: <p>I want to write a VBA script that when Outlook receive a new email from a specific email address , the VBA script has to detect that and resend the new received email to all contacts in the address book . </p>
  
  <p>For now i was able to send an email to all contacts in address book :</p>
  
  <pre><code>Sub SendEmails()
  Dim ContactsFolder As Folder
  Set ContactsFolder = Session.GetDefaultFolder(olFolderContacts)
  Dim Contact As Object
  Dim olApp As Outlook.Application
  Dim objMail As Outlook.MailItem
  Set olApp = Outlook.Application
  
  For Each Contact In ContactsFolder.Items
      Set objMail = olApp.CreateItem(olMailItem)
      With objMail
          .Subject = "Subject of the received email"
          .Body = "Body of the received email"
          .To = Contact.Email1Address
          .Send
      End With
  Next
  End Sub
  </code></pre>
  
  <p>but how to use this script so it called when a new email received from a specific email address.</p>
  
  <p>i tried  to put this in ThisOulookSeassion to check for new message event so i could call my above code within it :</p>
  
  <pre><code>Private Sub Application_NewMail()
  MsgBox "New mail"
  End Sub
  </code></pre>
  
  <p>but it didn't work.</p>
  
  <p>Also i tried this (i put it in ThisOulookSeassion too) :</p>
  
  <pre><code>Private WithEvents Items As Outlook.Items 
  Private Sub Application_Startup() 
  Dim olApp As Outlook.Application 
  Dim objNS As Outlook.NameSpace 
  Set olApp = Outlook.Application 
  Set objNS = olApp.GetNamespace("MAPI") 
  ' default local Inbox
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items 
   End Sub
    Private Sub Items_ItemAdd(ByVal item As Object) 
  
   On Error Goto ErrorHandler 
  Dim Msg As Outlook.MailItem 
   If TypeName(item) = "MailItem" Then
     Set Msg = item 
     ' ******************
     ' and placing my code here.
     ' ******************
     End If
   ProgramExit: 
    Exit Sub
   ErrorHandler: 
     MsgBox Err.Number &amp; " - " &amp; Err.Description 
    Resume ProgramExit 
   End Sub
  </code></pre>
  
  <p>but when i click run it ask me to create  new macro and don't run the code.</p>
  
  <p>Any suggestions ?</p>