NewMailEx event not Triggered

[savindrasingh]

Hello experts,




I am working on a macro to automate the processing of incoming mails using below code:

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
 
 
Dim xlApp As New Excel.Application
 
 
Dim xlBook As New Excel.Workbook
 
 
Dim varEntryIDs, objItem
 
 
Dim i As Integer
 
 

 
 
Const OLECMDID_COPY = 12
 
 
Const OLECMDID_SELECTALL = 17
 
 
Const OLECMDEXECOPT_DODEFAULT = 0
 
 
Const OLECMDEXECOPT_PROMPTUSER = 1
 
 
Const OLECMDEXECOPT_DONTPROMPTUSER = 2
 
 
Const OLECMDEXECOPT_SHOWHELP = 3
 
 

 
 
Set ie = CreateObject("internetexplorer.application")
 
 

 
 
varEntryIDs = Split(EntryIDCollection, ",")
   For i = 0 To UBound(varEntryIDs)
       Set objItem = Application.Session.GetItemFromID(varEntryIDs(i))
       If Left(objItem.Subject, 7) = "Action:" Then
           ChDir ("C:\Temp")
           TimeStamp = Format(Date, "dd-MM-yyyy") & Format(Time, "_HH_MM_SS")
           OutFile = "Dss" & TimeStamp & ".html"
           objItem.SaveAs "C:\Temp\" & OutFile, olHTML
           url = "file:///C:/Temp/" & OutFile
           Set xlBook = xlApp.Workbooks.Add(1)
               With ie
                   .Top = 1
                   .Left = 1
                   .Height = 400
                   .Width = 500
                   .AddressBar = False
                   .MenuBar = False
                   .Toolbar = False
                   .Visible = True
                   .Navigate url
                   Do While .ReadyState <> 4
                       DoEvents
                   Loop
                   
                   .ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DONTPROMPTUSER
                   .ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
               End With
               xlApp.Visible = True
               xlApp.Application.DisplayAlerts = False
               xlBook.Activate
               xlApp.ActiveSheet.Paste
               xlApp.Range("1:5").EntireRow.Delete
               xlApp.Range("1:1").EntireRow.Hidden = True
               xlApp.Range(xlApp.Range("A1").End(xlDown).Offset(1, 0).Row & ":" & xlApp.Range("A1").End(xlDown).Offset(1, 0).Row + 3).EntireRow.Hidden = True
               xlApp.Cells.SpecialCells(xlCellTypeVisible).Columns.WrapText = False
               xlApp.Cells.SpecialCells(xlCellTypeVisible).Columns.AutoFit
               xlApp.Cells.EntireRow.Hidden = False
               xlBook.SaveAs FileName:="C:\Temp\Dss" & TimeStamp & ".xls", FileFormat:=xlNormal
               xlBook.Close
               xlApp.Application.DisplayAlerts = True
               xlApp.Quit
               ie.Quit
               Kill "C:\Temp\" & OutFile
               Kill ("C:\Temp\Dss" & TimeStamp & "_files\*.*")
               RmDir ("C:\Temp\Dss" & TimeStamp & "_files")
       End If
   Next
 
 
End Sub

This code is working perfectly on my PC but the same code is not working on my colleague's PC. The NewMailEx event is not getting triggered.


Any ideas?

 

[savindrasingh]

I had just tested below code to see if the events are gettings triggered but nothing happens when I recieve an email :-(

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
 
 
MsgBox "New mail !"
 
 
End Sub

It should atleast show the msgbox but nothing happens :-( any IDEAS ??

 

[Ken Slovak - [MVP - Outlook]]

If VBA code is running on one machine and not another you need to check the

VBA and security settings for your versions of Outlook, which you don't

mention.

"savindrasingh" <savindrasingh.48boda@invalid> wrote in message

news:savindrasingh.48boda@invalid...

> I had just tested below code to see if the events are gettings triggered
> but nothing happens when I recieve an email :-(

> Code:
> ------------------> Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
> MsgBox "New mail !"
> End Sub

> ------------------
> It should atleast show the msgbox but nothing happens :-( any IDEAS ??

> > savindrasingh

> THANKS AND REGARDS,
> SavindraSingh
> >