N
noone
All,
I have deployed a COM object for Outlook but for some reason on a few
machines (approx. 3 out of 50), it causes Outlook to "create an error
report" when Outlook closes. What is the best way to track down why this is
being caused ?
Thanks everyone.
***********
Code from Connect.Dsr
***********
Option Explicit
Dim TrustedOL As Outlook.Application
Dim WithEvents myControl As CommandBarButton
Private Sub AddinInstance_OnConnection(ByVal Application As Object, _
ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, _
ByVal AddInInst As Object, custom() As Variant)
On Error Resume Next
Dim oExp As Outlook.Explorer
Dim oBar As Office.CommandBar
Set oExp = Outlook.ActiveExplorer
Set oBar = oExp.CommandBars.Item("Standard")
Set myControl = oBar.FindControl(, , "Spam")
If myControl Is Nothing Then
Set myControl = oBar.Controls.Add(, , , 11, True)
With myControl
.Caption = "Spam"
.FaceId = 1019
.Style = msoButtonIconAndCaption
.Tag = "Process selected email(s) as Spam"
.Visible = True
End With
End If
End Sub
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As _
AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
On Error Resume Next
TrustedOL.ActiveExplorer.CommandBars.Item("Standard").Reset
Set TrustedOL = Nothing
Set myControl = Nothing
End Sub
Private Sub myControl_Click(ByVal Ctrl As _
Office.CommandBarButton, CancelDefault As Boolean)
Call basUnsolicited
End Sub
***********
Code from SpamCode.Bas
***********
Function R_GetSenderAddress(objMsg)
Dim strType
Dim objSenderAE
Dim objSMail
Const PR_SENDER_ADDRTYPE = &HC1E001E
Const PR_EMAIL = &H39FE001E
Dim objFSO As Scripting.FileSystemObject
Dim objTextStream As Scripting.TextStream
Dim CurUserProfile As String
Dim Junk_Senders_File As String
Set objSMail = CreateObject("Redemption.SafeMailItem")
objSMail.Item = objMsg
strType = objSMail.Fields(PR_SENDER_ADDRTYPE)
CurUserProfile = Environ("userprofile")
Junk_Senders_File = CurUserProfile & "\Application
Data\Microsoft\Outlook\Junk Senders.txt"
Set objFSO = New Scripting.FileSystemObject
If objFSO.FileExists(FileSpec:=Junk_Senders_File) = False Then
Set objTextStream =
objFSO.CreateTextFile(FileName:=Junk_Senders_File)
Else
Set objTextStream = objFSO.OpenTextFile(FileName:=Junk_Senders_File,
IOMode:=ForAppending)
End If
Set objSenderAE = objSMail.Sender
If Not objSenderAE Is Nothing Then
If strType = "SMTP" Then
R_GetSenderAddress = objSenderAE.Address
ElseIf strType = "EX" Then
R_GetSenderAddress = objSenderAE.Fields(PR_EMAIL)
End If
End If
objTextStream.WriteLine Text:=R_GetSenderAddress
Set objSenderAE = Nothing
Set objSMail = Nothing
End Function
Public Function sDomain(rsEmail As String) As String
On Error Resume Next
sDomain = Split(rsEmail, "@", 2)(1)
End Function
Sub basUnsolicited()
Dim oExp As Outlook.Explorer
Dim objSelection As Selection
Dim objItem As Object
Dim db As Database
Dim strSQL As String
Dim strDomain, strEmail As String
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Set m_red = CreateObject("Redemption.MAPIUtils")
Msg = "Process these email(s) as SPAM ?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "Anti-Spam"
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
If LenB(Dir$("X:\Installs\Outlook Anti-Spam\config.mdb")) Then
Set db =
DBEngine.Workspaces(0).OpenDatabase("X:\Installs\Outlook
Anti-Spam\config.mdb", , False)
End If
Set oExp = Outlook.ActiveExplorer
Set objSelection = oExp.Selection
If objSelection.Count > 0 Then
For Each objItem In objSelection
If TypeOf objItem Is MailItem Then
strEmail = R_GetSenderAddress(objItem)
strDomain = sDomain(strEmail)
If Not (strEmail Like "*domain.com") Then
If LenB(Dir$("X:\Installs\Outlook
Anti-Spam\config.mdb")) Then
strSQL = "INSERT INTO antispam2_blacklist
(entry,type) VALUES ('" & strEmail & "','1')"
db.Execute strSQL
strSQL = "INSERT INTO antispam2_blacklist
(entry,type) VALUES ('*@" & strDomain & "','1')"
db.Execute strSQL
End If
objItem.Delete
End If
End If
Next
End If
If LenB(Dir$("X:\Installs\Outlook Anti-Spam\config.mdb")) Then
db.Close
End If
End If
Set oExp = Nothing
Set objSelection = Nothing
Set objItem = Nothing
End Sub
I have deployed a COM object for Outlook but for some reason on a few
machines (approx. 3 out of 50), it causes Outlook to "create an error
report" when Outlook closes. What is the best way to track down why this is
being caused ?
Thanks everyone.
***********
Code from Connect.Dsr
***********
Option Explicit
Dim TrustedOL As Outlook.Application
Dim WithEvents myControl As CommandBarButton
Private Sub AddinInstance_OnConnection(ByVal Application As Object, _
ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, _
ByVal AddInInst As Object, custom() As Variant)
On Error Resume Next
Dim oExp As Outlook.Explorer
Dim oBar As Office.CommandBar
Set oExp = Outlook.ActiveExplorer
Set oBar = oExp.CommandBars.Item("Standard")
Set myControl = oBar.FindControl(, , "Spam")
If myControl Is Nothing Then
Set myControl = oBar.Controls.Add(, , , 11, True)
With myControl
.Caption = "Spam"
.FaceId = 1019
.Style = msoButtonIconAndCaption
.Tag = "Process selected email(s) as Spam"
.Visible = True
End With
End If
End Sub
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As _
AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
On Error Resume Next
TrustedOL.ActiveExplorer.CommandBars.Item("Standard").Reset
Set TrustedOL = Nothing
Set myControl = Nothing
End Sub
Private Sub myControl_Click(ByVal Ctrl As _
Office.CommandBarButton, CancelDefault As Boolean)
Call basUnsolicited
End Sub
***********
Code from SpamCode.Bas
***********
Function R_GetSenderAddress(objMsg)
Dim strType
Dim objSenderAE
Dim objSMail
Const PR_SENDER_ADDRTYPE = &HC1E001E
Const PR_EMAIL = &H39FE001E
Dim objFSO As Scripting.FileSystemObject
Dim objTextStream As Scripting.TextStream
Dim CurUserProfile As String
Dim Junk_Senders_File As String
Set objSMail = CreateObject("Redemption.SafeMailItem")
objSMail.Item = objMsg
strType = objSMail.Fields(PR_SENDER_ADDRTYPE)
CurUserProfile = Environ("userprofile")
Junk_Senders_File = CurUserProfile & "\Application
Data\Microsoft\Outlook\Junk Senders.txt"
Set objFSO = New Scripting.FileSystemObject
If objFSO.FileExists(FileSpec:=Junk_Senders_File) = False Then
Set objTextStream =
objFSO.CreateTextFile(FileName:=Junk_Senders_File)
Else
Set objTextStream = objFSO.OpenTextFile(FileName:=Junk_Senders_File,
IOMode:=ForAppending)
End If
Set objSenderAE = objSMail.Sender
If Not objSenderAE Is Nothing Then
If strType = "SMTP" Then
R_GetSenderAddress = objSenderAE.Address
ElseIf strType = "EX" Then
R_GetSenderAddress = objSenderAE.Fields(PR_EMAIL)
End If
End If
objTextStream.WriteLine Text:=R_GetSenderAddress
Set objSenderAE = Nothing
Set objSMail = Nothing
End Function
Public Function sDomain(rsEmail As String) As String
On Error Resume Next
sDomain = Split(rsEmail, "@", 2)(1)
End Function
Sub basUnsolicited()
Dim oExp As Outlook.Explorer
Dim objSelection As Selection
Dim objItem As Object
Dim db As Database
Dim strSQL As String
Dim strDomain, strEmail As String
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Set m_red = CreateObject("Redemption.MAPIUtils")
Msg = "Process these email(s) as SPAM ?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "Anti-Spam"
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
If LenB(Dir$("X:\Installs\Outlook Anti-Spam\config.mdb")) Then
Set db =
DBEngine.Workspaces(0).OpenDatabase("X:\Installs\Outlook
Anti-Spam\config.mdb", , False)
End If
Set oExp = Outlook.ActiveExplorer
Set objSelection = oExp.Selection
If objSelection.Count > 0 Then
For Each objItem In objSelection
If TypeOf objItem Is MailItem Then
strEmail = R_GetSenderAddress(objItem)
strDomain = sDomain(strEmail)
If Not (strEmail Like "*domain.com") Then
If LenB(Dir$("X:\Installs\Outlook
Anti-Spam\config.mdb")) Then
strSQL = "INSERT INTO antispam2_blacklist
(entry,type) VALUES ('" & strEmail & "','1')"
db.Execute strSQL
strSQL = "INSERT INTO antispam2_blacklist
(entry,type) VALUES ('*@" & strDomain & "','1')"
db.Execute strSQL
End If
objItem.Delete
End If
End If
Next
End If
If LenB(Dir$("X:\Installs\Outlook Anti-Spam\config.mdb")) Then
db.Close
End If
End If
Set oExp = Nothing
Set objSelection = Nothing
Set objItem = Nothing
End Sub