S
savindrasingh
Hello experts,
I am working on a macro to automate the processing of incoming mails
using below code:
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?
I am working on a macro to automate the processing of incoming mails
using below code:
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?