Re: An event raise twice when click the button.
- From: DavidE <DavidE@xxxxxxxxxxxxxxxxxxxxxxxxx>
- Date: Mon, 17 Jul 2006 00:21:01 -0700
Hi,
I create this add-in using vb 6 and outlook 2003.
I use setup and deployment wizard of vb 6 to create the package and then use
the setup.exe file to install the add-in on users machines.
Batap_Connect.Dsr:
Option Explicit
'******************************************************************************
'Outlook COM Add-In project template
'IDTExtensibility2 is the interface that COM Add-ins must implement.
'The project references the following object libraries:
'Add additional object libraries as required for your COM Add-in.
'References:
'Microsoft Add-In Designer
'Microsoft Outlook 10.0 Object Library
'Microsoft Office 10.0 Object Library
'Class: Connect
'Purpose: Outlook 2002 COM Add-in
'Initial Load: Startup
'******************************************************************************
'Use Implements IDTExtensibility2 in VB5 environment
'Implements IDTExtensibility2
Private gBaseClass As New Batap_OutAddIn
Private Sub AddinInstance_OnAddInsUpdate(custom() As Variant)
'
'DebugWrite "AddinInstance_OnAddInsUpdate"
End Sub
Private Sub AddinInstance_OnBeginShutdown(custom() As Variant)
'
'DebugWrite "AddinInstance_OnBeginShutdown"
End Sub
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
'Evaluate ConnectMode
Select Case ConnectMode
Case ext_cm_Startup
Case ext_cm_AfterStartup
Case ext_cm_CommandLine
Case ext_cm_Startup
End Select
'Don't call InitHandler if Explorers.Count = 0 and Inspectors.Count = 0
If Application.Explorers.Count = 0 And Application.Inspectors.Count = 0
Then
Exit Sub
End If
'AddInInst represents COMAddIn object
'Create and Initialize a base class
gBaseClass.InitHandler Application, AddInInst.progID
'DebugWrite "IDT2 OnConnection"
End Sub
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode _
As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
'Tear down the class
'IMPORTANT: This event will not fire when
'RemoveMode = ext_dm_HostShutdown
'It will fire when RemoveMode = ext_dm_UserClosed
gBaseClass.UnInitHandler
If RemoveMode = ext_dm_UserClosed Then
'User shutdown removed COM Add-in
'Cleanup custom toolbars by deleting them
Else
'Host shutdown
End If
Set gBaseClass = Nothing
'DebugWrite "AddinInstance_OnDisconnection"
End Sub
Private Sub AddinInstance_OnStartupComplete(custom() As Variant)
'
'DebugWrite "AddinInstance OnStartupComplete"
End Sub
*************************************************************************************
Batap_clsInspWrap.cls:
My problem is in btnMerkava_Click event
'************************************************************
' This code is in the class module used as an Inspector
' wrapper. One instance of this class is added to a
' collection each time a new Inspector is opened and
' the instance is removed from the collection when the
' Inspector closed. The class is called clsInspWrap.
'************************************************************
Private WithEvents m_objInsp As Outlook.Inspector
Private WithEvents m_objMail As Outlook.MailItem
Private WithEvents m_objContact As Outlook.ContactItem
Private WithEvents cbbButton As Office.CommandBarButton
Private m_obj As Object
Private m_intID As Integer
Private mnuTag As String
Private m_blnMailInspector As Boolean
Private m_blnWord As Boolean
Private WithEvents btnMerkava As CommandBarButton
Private WithEvents btnFax As CommandBarButton
Private strProgId As String
Private Sub btnFax_Click(ByVal Ctrl As Office.CommandBarButton,
CancelDefault As Boolean)
frmFaxNumber.Show vbModal
End Sub
Private Sub btnMerkava_Click(ByVal Ctrl As Office.CommandBarButton,
CancelDefault As Boolean)
On Error Resume Next
MsgBox "Sub btnMerkava_Click(...) "
Dim tempMailItem As Outlook.MailItem
Dim colAttach As Attachments
Dim objAttach As Attachment
Dim i, filesCount As Integer
Dim curDate As String
Dim strFileIndx As String
Dim newFileName As String
Dim mrkvFolder As Object
Dim fs As New FileSystemObject
Dim f As TextStream
Dim strRow As String
Dim colFiles As Object
Dim strBody As String
Dim packNum As Integer
Dim newPackNum As Integer
Dim strNewPackNum As String
Dim strPackNum As String
Dim blBody As Boolean
Dim arrAtach() As String
Dim mrkvUsrMail As String
Dim strMrkvUsrMail As String
Dim frwrdItem As MailItem
Dim strLine As String
Dim strHeadLine As String
Dim strSuffix As String
Dim wrongType As Boolean
blBody = False
'If m_objMail.Sent = True Then
' dlgFirst.Show vbModal, Me
'
' If blMM = True Then
Set f = fs.OpenTextFile("C:\MerkavaFiles\Config\MrkvData.ini",
ForReading, False, TristateUseDefault)
If Err.Number = 76 Then
MsgBox "÷åáõ äðúåðéí ìà ðîöà á-
C:\MerkavaFiles\Config\MrkvData.ini", vbCritical + vbOKOnly, "îùìåç ÷áöéí
ìîøëáä"
GoTo BeforExit
ElseIf Err.Number > 0 Then
MsgBox "ùâéàä áôúéçú ä÷åáõ -
C:\MerkavaFiles\Config\MrkvData.ini", vbCritical + vbOKOnly, "îùìåç ÷áöéí
ìîøëáä"
GoTo BeforExit
End If
Do While f.AtEndOfStream <> True
strLine = f.ReadLine
strHeadLine = Mid(strLine, 1, InStr(1, strLine, "=") - 1)
Select Case strHeadLine
Case "ArcEmail"
strMrkvUsrMail = strLine
Case "ArcRun"
packNum = Mid(strLine, InStr(1, strLine, "=") + 1)
End Select
Loop
f.Close
'fs.DeleteFile "C:\MerkavaFiles\Config\MrkvData.ini", True
fs.CreateTextFile "C:\MerkavaFiles\Config\MrkvData.ini", True, True
If Err > 0 Then
MsgBox "ùâéàä áéöéøú ÷åáõ - C:\MerkavaFiles\Config\MrkvData.ini"
& vbCrLf & Err.Description & vbCrLf & Err.Number, vbCritical + vbOKOnly,
"îùìåç ÷áöéí ìîøëáä"
GoTo BeforExit
End If
Set f = fs.OpenTextFile("C:\MerkavaFiles\Config\MrkvData.ini",
ForAppending, True, TristateUseDefault)
If Err > 0 Then
MsgBox "ùâéàä áôúéçú ÷åáõ - C:\MerkavaFiles\Config\MrkvData.ini"
& vbCrLf & Err.Description & vbcelf & Err.Number, vbCritical + vbOKOnly,
"îùìåç ÷áöéí ìîøëáä"
GoTo BeforExit
End If
newPackNum = packNum + 1
strNewPackNum = "ArcRun=" & newPackNum
f.WriteLine strMrkvUsrMail
f.WriteLine strNewPackNum
f.Close
mrkvUsrMail = Mid(strMrkvUsrMail, InStr(1, strMrkvUsrMail, "=") + 1)
Set mrkvFolder = fs.GetFolder("C:\MerkavaFiles\tempFiles")
If Err > 0 Then
MsgBox "ùâéàä áôúéçú äúé÷éä - C:\MerkavaFiles\tempFiles" &
vbCrLf & Err.Description & vbcelf & Err.Number, vbCritical + vbOKOnly, "îùìåç
÷áöéí ìîøëáä"
GoTo BeforExit
End If
Set colFiles = mrkvFolder.Files
For Each f1 In colFiles
f1.Delete
Next
Set tempMailItem = Application.CreateItem(olMailItem)
Set colAttach = m_objMail.Attachments
If colAttach.Count <> 0 Then
ReDim arrAtach(colAttach.Count - 1)
i = 1
For Each objAttach In colAttach
wrongType = False
strSuffix = LCase(Right(objAttach.FileName, 3))
curDate = Date
curDate = Replace(curDate, "/", "")
Select Case Len(CStr(i))
Case 1
strFileIndx = "000" & CStr(i)
Case 2
strFileIndx = "00" & CStr(i)
Case 3
strFileIndx = "0" & CStr(i)
End Select
Select Case strSuffix
Case "tif"
newFileName = strFileIndx & curDate & ".tif"
Case "doc"
newFileName = strFileIndx & curDate & ".doc"
Case "peg"
newFileName = strFileIndx & curDate & ".jpeg"
Case "txt"
newFileName = strFileIndx & curDate & ".txt"
Case "pdf"
newFileName = strFileIndx & curDate & ".pdf"
Case Else
wrongType = True
MsgBox "àéï àôùøåú ìùìåç ÷áöéí îñåâ : " &
strSuffix, vbExclamation + vbMsgBoxRtlReading, "îùìåç ÷áöéí ìîøëáä"
End Select
If wrongType = False Then
objAttach.DisplayName = newFileName
objAttach.SaveAsFile ("C:\MerkavaFiles\tempFiles\" &
newFileName)
If Err > 0 Then
MsgBox "ùâéàä áùîéøú ä÷åáõ á -
C:\MerkavaFiles\tempFiles" & vbCrLf & Err.Description & vbCrLf & Err.Number,
vbCritical + vbOKOnly, "îùìåç ÷áöéí ìîøëáä"
GoTo BeforExit
End If
arrAtach(i - 1) = newFileName
If blBody = False Then
Select Case Len(CStr(packNum))
Case 1
strPackNum = "00000000" & packNum
Case 2
strPackNum = "0000000" & packNum
Case 3
strPackNum = "000000" & packNum
Case 4
strPackNum = "00000" & packNum
Case 5
strPackNum = "0000" & packNum
Case 6
strPackNum = "000" & packNum
End Select
strPackNum = strPackNum & ":ARC_MM"
strBody = "<HTML><div align=left
style='direction: ltr'><p> " & _
"<TABLE border=1><TR><TD>" & strPackNum &
"<BR> " & _
"</TD></TR></TABLE></p></div></HTML> "
'tempMailItem. = olFormatHTML
tempMailItem.HTMLBody = strBody
blBody = True
tempMailItem.Subject = strPackNum
tempMailItem.Save
End If
i = i + 1
End If 'wrongType = False
Next
filesCount = i - 1
For i = 0 To filesCount - 1
tempMailItem.Attachments.Add ("C:\MerkavaFiles\tempFiles\" &
arrAtach(i))
If Err > 0 Then
MsgBox "àéøòä ùâéàä áäåñôú ÷åáõ î -
C:\MerkavaFiles\tempFiles" & vbCrLf & Err.Description & vbcelf & Err.Number,
vbCritical + vbOKOnly, "îùìåç ÷áöéí ìîøëáä"
GoTo BeforExit
End If
Next
tempMailItem.Save
'Set frwrdItem = tempMailItem.Forward
Set frwrdItem = tempMailItem
frwrdItem.To = mrkvUsrMail
frwrdItem.Subject = strPackNum
frwrdItem.HTMLBody = strBody
frwrdItem.Send
If Err > 0 Then
MsgBox "àéøòä ùâéàä áùìéçú ôøéè äãåàø ìîøëáä " & vbCrLf &
Err.Description & vbCrLf & "îñôø ùâéàä : " & Err.Number, vbCritical +
vbOKOnly, "îùìåç ÷áöéí ìîøëáä"
GoTo BeforExit
End If
m_objMail.AutoForwarded = True
If Err.Number > 0 Then MsgBox "m_objMail.AutoForwarded" & " " &
Err.Number
' When I close this item here on the target machines, the
m_objMail_close(...) event fires twice.
m_objMail.Close olSave
If Err > 0 Then
MsgBox "àéøòä ùâéàä áñâéøú ôøéè äãåàø " & vbCrLf &
Err.Description & vbCrLf & "îñôø ùâéàä : " & Err.Number, vbCritical +
vbOKOnly, "îùìåç ÷áöéí ìîøëáä"
GoTo BeforExit
End If
Else
MsgBox "àéå ÷áöéí îöåøôéí", vbInformation, "îùìåç ÷áöéí ìîøëáä"
End If
For Each f1 In colFiles
f1.Delete
Next
'End If '***** If m_objMail.Sent = True *******
' End If '**** If blMM = True ********
BeforExit:
Set tempMailItem = Nothing
Set colAttach = Nothing
Set objAttach = Nothing
Set fs = Nothing
Set f = Nothing
Set mrkvFolder = Nothing
Set colFiles = Nothing
End Sub
Private Sub cbbButton_Click(ByVal Ctrl As Office.CommandBarButton, _
CancelDefault As Boolean)
On Error Resume Next
'code here to handle a click of the menu/toolbar button
' and perform whatever function you want.
End Sub
Private Sub Class_Initialize()
On Error Resume Next
Set m_objInsp = Nothing
Set m_objMail = Nothing
Set m_objContact = Nothing
Set cbbButton = Nothing
Set m_obj = Nothing
m_blnWord = False
End Sub
Private Sub Class_Terminate()
On Error Resume Next
Set m_objInsp = Nothing
Set m_objMail = Nothing
Set m_objContact = Nothing
Set cbbButton = Nothing
Set m_obj = Nothing
End Sub
Public Function InitButton() As Boolean
On Error Resume Next
'if you want buttons only for
' certain item types you can test
' for that here using
' m_objInsp.CurrentItem.Class.
If m_objInsp.CurrentItem.Class = olMail Then
Call CreateButtons(m_objInsp)
End If
'you can now enable/disable buttons depending
' on what type if item is opened if you want.
End Function
Public Property Let MailItem(objMail As Outlook.MailItem)
On Error Resume Next
Set m_objMail = objMail
m_strMailID = objMail.EntryID
m_blnMailInspector = True
End Property
Public Property Let ContactItem(objContact As Outlook.ContactItem)
On Error Resume Next
Set m_objContact = objContact
m_strContactID = objContact.Importance
m_blnMailInspector = False
End Property
Public Property Let Inspector(objInspector As Outlook.Inspector)
On Error Resume Next
Set m_objInsp = objInspector
End Property
Public Property Get Inspector() As Outlook.Inspector
On Error Resume Next
Set Inspector = m_objInsp
End Property
Public Property Let Key(lngID As Long)
On Error Resume Next
m_intID = lngID
End Property
Public Property Get Key() As Long
On Error Resume Next
Key = m_intID
End Property
Private Sub m_objContact_Close(Cancel As Boolean)
On Error Resume Next
'can handle various events for the contact item
' in the Inspector like Close and Open.
On Error Resume Next
If Cancel = False Then
Call KillButtons
basOutlInsp.KillInsp m_intID, Me
Set m_objInsp = Nothing
End If
End Sub
Private Sub m_objContact_Open(Cancel As Boolean)
On Error Resume Next
'can handle various events for the contact item
' in the Inspector like Close and Open.
End Sub
Private Sub m_objMail_Open(Cancel As Boolean)
On Error Resume Next
'can handle various events for the mail item
' in the Inspector like Close and Open.
End Sub
Private Sub m_objMail_Close(Cancel As Boolean) ' This event occures twice
on target machines but on mine it occure just once
On Error Resume Next
MsgBox "Sub m_objMail_Close(Cancel As Boolean)"
'can handle various events for the mail item
' in the Inspector like Close and Open.
If Cancel = False Then
If Err.Number > 0 Then MsgBox "m_objMail_Close: BEFORE - Call
KillButtons" & " " & Err.Description & " " & Err.Number & " " & Err.Source
Call KillButtons
If Err.Number > 0 Then MsgBox "m_objMail_Close: AFTER - Call
KillButtons" & " " & Err.Description & " " & Err.Number & " " & Err.Source
Batap_basOutlInsp.KillInsp m_intID, Me
Set m_objInsp = Nothing
End If
End Sub
'Destroy Inspector object in InspWrap
Private Sub m_objInsp_Close()
On Error Resume Next
MsgBox "m_objInsp_Close()"
Call KillButtons
If Err.Number > 0 Then MsgBox "m_objInsp_Close-Call KillButtons" & " " &
Err.Description & " " & Err.Number & " " & Err.Source
Batap_basOutlInsp.KillInsp m_intID, Me
Set m_objInsp = Nothing
End Sub
Private Sub KillButtons()
On Error Resume Next
MsgBox "Private Sub KillButtons()"
Dim inspBar As Office.CommandBar
If Err.Number > 0 Then MsgBox "BEFORE - Set inspBar = " & " " &
Err.Description & " " & Err.Number & " " & Err.Source
Set inspBar = m_objInsp.CommandBars("BatapBar")
If Err.Number > 0 Then MsgBox "AFTER - Set inspBar = " & " " &
Err.Description & " " & Err.Number & " " & Err.Source
If Not inspBar Is Nothing Then
inspBar.Delete
End If
If Err.Number > 0 Then Err.Clear
Set inspBar = Nothing
End Sub
Private Sub CreateButtons(objInspector As Outlook.Inspector)
On Error Resume Next
'Adding a new menu item and a button to the main menu for any Inspector
' must take a different approach if using Word as email editor.
Dim oPic As StdPicture
Dim customBar As Office.CommandBar
Dim strKey As String
' Load the picture (.bmp file) to use for the button image.
Set oPic = LoadPicture("C:\Program Files\BatapBar_AddIn\Merkava.bmp")
If oPic Is Nothing Then
MsgBox "File not found at C:\Program
Files\BatapBar_AddIn\Merkava.bmp ", vbCritical, "Merkava"
End If
Set customBar = objInspector.CommandBars.Add("BatapBar", msoBarTop, ,
True)
strKey = CStr(m_intID)
'strTag = "This string is unique to this button" & strKey
Set btnMerkava = customBar.Controls.Add(Type:=msoControlButton,
Temporary:=True)
With btnMerkava
.ToolTipText = "äòáøú ÷áöéí ìîøëáä"
.Tag = strTag
.Style = msoButtonIconAndCaption
.Caption = "îøëáä "
.Visible = True
'*** This string is unique to this button
.Tag = "Merkava" & strKey
'.OnAction = "<!" & strProgId & ">"
' Here we create a mask based on the image and put both
' the image and the mask on the clipboard. Any color areas with
' magenta will be transparent.
CopyBitmapAsButtonFace oPic, &HFF00FF
' PasteFace will now add the image with transparency.
.PasteFace
End With
If m_objMail.Sent = False Then
Set btnFax = customBar.Controls.Add(Type:=msoControlButton,
Temporary:=True)
With btnFax
.ToolTipText = "îùìåç ô÷ñ ìðîòðéí"
.Tag = strTag
.Style = msoButtonIconAndCaption
.FaceId = 461
.Caption = "ô÷ñ"
.Visible = True
'*** This string is unique to this button
.Tag = "Fax" & strKey
'.OnAction = "<!" & strProgId & ">"
End With
End If
customBar.Visible = True
Set cmdBars = Nothing
Set customBar = Nothing
Err.Clear
End Sub
Public Property Let SetProgID(ByVal strProg As String)
strProgId = strProg
End Property
**********************************************************************************************
Batap_OutAddIn.cls
'******************************************************************************
'Outlook COM Add-in project template
'IDTExtensibility2 is the interface that COM Add-ins must implement.
'The project references the following object libraries:
'Add additional object libraries as required for your COM Add-in
'References:
'Microsoft Add-In Designer
'Microsoft Outlook 10.0 Object Library
'Microsoft Office 10.0 Object Library
'Class: OutAddIn
'Instancing: MultiUse
'Public Events:
'Public Functions:
'Public Properties:
'******************************************************************************
Option Explicit
'Object variables for Event procedures
Private WithEvents objOutlook As Outlook.Application
Private WithEvents objNS As Outlook.NameSpace
Private WithEvents objExpl As Outlook.Explorer
Private WithEvents colExpl As Outlook.Explorers
'Private WithEvents colViews As Outlook.Views
'Private WithEvents objResults As Outlook.Results
'Private WithEvents colReminders As Outlook.Reminders
Private WithEvents objInsp As Outlook.Inspector
Private WithEvents colInsp As Outlook.Inspectors
Private WithEvents objMailItem As Outlook.MailItem
'Private WithEvents objPostItem As Outlook.PostItem
Private WithEvents objContactItem As Outlook.ContactItem
'Private WithEvents objDistListItem As Outlook.DistListItem
'Private WithEvents objApptItem As Outlook.AppointmentItem
'Private WithEvents objTaskItem As Outlook.TaskItem
'Private WithEvents objJournalItem As Outlook.JournalItem
'Private WithEvents objDocumentItem As Outlook.DocumentItem
'Use gstrProgID to set the OnAction property of command bar buttons
Private gstrProgID As String
'Declare CommandBar, CommandBarButton, and CommandBarComboBox object
variables here
'Don't use WithEvents for CommandBar object
'Remove comments to declare object variables for CommandBar objects
'Private objCB As Office.CommandBar
'Private WithEvents objCBButton As Office.CommandBarButton
'Private WithEvents objCBComboBox As Office.CommandBarComboBox
Friend Sub InitHandler(olApp As Outlook.Application, strProgId As String)
'Declared WithEvents
Set objOutlook = olApp 'Application Object
'Instantiate a public module-level Outlook application variable
Set golApp = olApp
'CDO Session if required
'Uncomment for CDO
'Set gobjCDO = CreateObject("MAPI.Session")
'gobjCDO.Logon "", "", False, False
'ProgID string required for CommandBarControls
gstrProgID = strProgId
'Declared WithEvents
Set objNS = objOutlook.GetNamespace("MAPI") 'NameSpace Object
'Set colReminders = objOutlook.Reminders 'Reminders Object
Set colExpl = objOutlook.Explorers 'Explorers Object
Set colInsp = objOutlook.Inspectors 'Inspectors Object
Set objExpl = objOutlook.ActiveExplorer 'Explorer Object
End Sub
Friend Sub UnInitHandler()
'You must dereference all objects in this procedure
'or Outlook will remain in memory
'Unload all forms in this procedure
'If you have created an objMailItem variable,
'be sure to Set objMailItem = Nothing in this procedure
Set objInsp = Nothing
Set objExpl = Nothing
Set colInsp = Nothing
Set colExpl = Nothing
'Set colReminders = Nothing
'Set colViews = Nothing
Set objNS = Nothing
Set golApp = Nothing
'Set gobjCDO = Nothing 'Uncomment for CDO
Set objOutlook = Nothing
End Sub
'Add Set statements as required
'Also remove unnecessary object declarations
Private Sub colInsp_NewInspector(ByVal Inspector As Inspector)
Dim objItem As Object
Dim strID As String
On Error Resume Next
Set objInsp = Inspector
Set objItem = objInsp.CurrentItem
Select Case objItem.Class
Case olMail
'Set objMailItem = objItem
strID = AddInsp(Inspector, gstrProgID)
Case olPost
'Set objPostItem = objItem
Case olAppointment
'Set objApptItem = objItem
Case olContact
'Set objContactItem = objItem
Case olDistributionList
'Set objDistListItem = objItem
Case olTask
'Set objTaskItem = objItem
Case olJournal
'Set objJournalItem = objItem
Case olDocument
'Set objDocumentItem = objItem
End Select
End Sub
Private Sub objExpl_BeforeFolderSwitch(ByVal NewFolder As Object, Cancel As
Boolean)
On Error Resume Next
'Set colViews = NewFolder.Views
End Sub
'Due to MAPI issues, On_Disconnection might not fire during Outlook shutdown
'Call UnInitHandler in objExpl_Close event
Private Sub objExpl_Close()
On Error Resume Next
If golApp.Explorers.Count <= 1 And golApp.Inspectors.Count = 0 Then
UnInitHandler
End If
End Sub
'Call UnInitHandler in objInsp_Close event
Private Sub objInsp_Close()
On Error Resume Next
If golApp.ActiveExplorer Is Nothing And golApp.Inspectors.Count <= 1 Then
UnInitHandler
End If
End Sub
**************************************************************
Batap_basOutlInsp.bas
'************************************************************
' This code is in a code module called basOutlInsp. The
' wrapper class for an Inspector is called clsInspWrap.
' The collection that holds the Inspector wrapper
' classes is called g_colInspWrap. It is declared in a
' code module as a global Collection object.
'************************************************************
Public g_colInspWrap As New Collection
Private intID As Integer
Private blnActivate As Boolean
Public Function AddInsp(Inspector As Outlook.Inspector, progID As String) As
String
Dim objInspWrap As New Batap_clsInspWrap
Dim objItem As Object
Dim strID As String
On Error Resume Next
'set the progID
objInspWrap.SetProgID = progID
'set the Inspector in the class
objInspWrap.Inspector = Inspector
Set objItem = Inspector.CurrentItem
'test which Outlook item type is here
Select Case objItem.Class
Case olMail
'we are handling events for this item type,
' so add a new class to the collection and
' set up the item in the Inspector so events
' for the item can be handled.
objInspWrap.MailItem = objItem
Case olContact
objInspWrap.ContactItem = objItem
Case Else
End Select
objInspWrap.Key = intID
strID = CStr(intID)
'add the class to the collection with a
' unique Key value.
g_colInspWrap.Add objInspWrap, strID
'create buttons and menus for the Inspector
objInspWrap.InitButton
AddInsp = strID
intID = intID + 1
Set objInspWrap = Nothing
Set objItem = Nothing
End Function
Public Sub KillInsp(intID As Integer, objInspWrap As Batap_clsInspWrap)
MsgBox "Sub KillInsp(intID As Integer, objInspWrap As Batap_clsInspWrap)"
If Err.Number > 0 Then MsgBox "BEFORE - Dim objInspWrap2 As
Batap_clsInspWrap" & " " & Err.Description & " " & Err.Number & " " &
Err.Source
Dim objInspWrap2 As Batap_clsInspWrap
If Err.Number > 0 Then MsgBox "Dim objInspWrap2 As Batap_clsInspWrap" & " "
& Err.Description & " " & Err.Number & " " & Err.Source
'On Error Resume Next
Set objInspWrap2 = g_colInspWrap.Item(CStr(intID))
'Set objInspWrap2 = g_colInspWrap.Item(intID)
' check to make sure we're removing the
' correct Inspector from the collection.
If Err.Number > 0 Then MsgBox "Set objInspWrap2 " & " " & Err.Description &
" " & Err.Number & " " & Err.Source
If Not objInspWrap2 Is objInspWrap Then
'If objInspWrap2 Is objInspWrap Then
MsgBox "If Not objInspWrap2 Is objInspWrap Then"
Err.Raise 1, Description:="Unexpected Error in KillInsp : "
GoTo ExitSub
End If
g_colInspWrap.Remove CStr(intID)
ExitSub:
Set objInspWrap2 = Nothing
End Sub
***********************************************************************
Batap_basOutlook.bas
Option Explicit
'Use this public Outlook Application variable in module code
'Be sure to dereference this object variable in UnInitHandler
Public golApp As Outlook.Application
'Declare other public object variables in module level code
'Collaboration Data Objects Session object
'Dim gobjCDO As MAPI.Session
********************************************************
Batap_basRegistry.bas
'*************************************************************************
'Building Applications with Microsoft Outlook 2002
'by Randy Byrne, Micro Eye, Inc.
'(c) 2001 Microsoft Corporation
'Module: basRegistry
'*************************************************************************
Option Explicit
' I don't have anough place to post the code for this class but I never
change this code.
Thanks,
David
"Michael Bauer" wrote:
Am Sun, 16 Jul 2006 04:17:01 -0700 schrieb DavidE:.
Please post the relevant code.
--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.VBOffice.net --
Hi ,machine
I created a Command bar with two buttons.Both have a uniqe Tag value each
time the bar is created. When I install this add-in in my developing
it's work great. But when I install it in another machine I see that whenI
click one of those buttons the mailItem_Close event raises twice and it
cause problems.
I don't understand the reason it raises twice.
Can you help me to solve this problem ?
Thanks,
David
- Follow-Ups:
- Re: An event raise twice when click the button.
- From: Michael Bauer
- Re: An event raise twice when click the button.
- References:
- Re: An event raise twice when click the button.
- From: Michael Bauer
- Re: An event raise twice when click the button.
- Prev by Date: Re: Change subject on forwarded email
- Next by Date: Re: Change subject on forwarded email
- Previous by thread: Re: An event raise twice when click the button.
- Next by thread: Re: An event raise twice when click the button.
- Index(es):