N
Newt
I'm a hack at writing this code, but here goes. I added a toggle button
several months ago that works great for adding Read Receipts. Now, I'd like
to add another button that allows me to select whether I save a copy in the
Sent Items folder. I figured out the correct code for one button, but don't
know how to make it work so that both buttons function together. Any help?
'THIS OUTLOOK SESSION
Private WithEvents m_oInspector As Outlook.Inspector
Private WithEvents m_oMailItem As Outlook.MailItem
Private WithEvents YourButton As Office.CommandBarButton
Private WithEvents YourButton1 As Office.CommandBarButton
Private m_lKey As Long
Friend Function Init(oInspector As Outlook.Inspector, ByVal lKey As Long) As
Boolean
Set m_oInspector = oInspector
Set m_oMailItem = oInspector.CurrentItem
If m_oMailItem.Sent = False Then
m_lKey = lKey
CreateButton oInspector
CreateButton1 oInspector
Init = True
End If
End Function
Private Sub CreateButton(Inspector As Outlook.Inspector)
Dim objCB As Office.CommandBar
Dim colCB As Office.CommandBars
Dim objPicture As stdole.IPictureDisp
Dim objMask As stdole.IPictureDisp
Const PICTURE_PATH As String = "C:\Documents and
Settings\drhyase\Icons\readreceipt.bmp"
Const PICTURE_MASK As String = "C:\Documents and
Settings\drhyase\Icons\readreceiptmask.bmp"
Set colCB = Inspector.CommandBars
Set objCB = colCB.Item("Standard")
Set colCBcontrols = objCB.Controls
Set YourButton = colCBcontrols.Add(msoControlButton, , "Standard", ,
True)
Set objPicture = LoadPicture(PICTURE_PATH)
Set objMask = LoadPicture(PICTURE_MASK)
With YourButton
.Caption = "&Read Receipt"
.Move Before:=3
.TooltipText = "Add/Remove a Read Receipt"
.Picture = objPicture
.Mask = objMask
.Style = msoButtonIconAndCaption
End With
Set objCB = Nothing
Set objCB = Nothing
End Sub
Private Sub CreateButton1(Inspector As Outlook.Inspector)
Dim objCB As Office.CommandBar
Dim colCB As Office.CommandBars
Set colCB = Inspector.CommandBars
Set objCB = colCB.Item("Standard")
Set colCBcontrols = objCB.Controls
Set YourButton1 = colCBcontrols.Add(msoControlButton, , "Standard",
, True)
With YourButton1
.Caption = "Save Copy"
.Move Before:=4
.TooltipText = "Save in Sent Items Folder"
.Style = msoButtonCaption
End With
Set objCB = Nothing
Set objCB = Nothing
End Sub
Friend Sub CloseInspector()
On Error Resume Next
Application.RemoveInspector m_lKey
Set YourButton = Nothing
Set YourButton1 = Nothing
Set m_oMailItem = Nothing
Set m_oInspector = Nothing
End Sub
Private Sub m_oInspector_Close()
CloseInspector
End Sub
Private Sub m_oMailItem_Close(Cancel As Boolean)
If m_oMailItem.Saved Then
CloseInspector
End If
End Sub
Private Sub m_oMailItem_Send(Cancel As Boolean)
CloseInspector
End Sub
Private Sub YourButton_Click1(ByVal Ctrl As Office.CommandBarButton,
CancelDefault As Boolean)
Dim objInsp1 As Outlook.Inspector
Dim objItem1 As MailItem
' get the currently open item and make sure it's a mail message
Set objInsp1 = Application.ActiveInspector
If Not objInsp1 Is Nothing Then
Set objItem1 = objInsp1.CurrentItem
If objItem1.Class = olMail Then
' make sure it's unsent
If objItem1.Sent = False Then
' button action on
If YourButton1.State = msoButtonUp Then
YourButton1.State = msoButtonDown
Else
YourButton1.State = msoButtonUp
End If
If objItem1.DeleteAfterSubmit = False Then
objItem1.DeleteAfterSubmit = True
' button action off
Else
objItem1.DeleteAfterSubmit = False
End If
End If
End If
End If
Set objInsp1 = Nothing
Set objItem1 = Nothing
End Sub
Private Sub YourButton_Click(ByVal Ctrl As Office.CommandBarButton,
CancelDefault As Boolean)
Dim objInsp As Outlook.Inspector
Dim objItem As MailItem
' get the currently open item and make sure it's a mail message
Set objInsp = Application.ActiveInspector
If Not objInsp Is Nothing Then
Set objItem = objInsp.CurrentItem
If objItem.Class = olMail Then
' make sure it's unsent
If objItem.Sent = False Then
' button action on
If YourButton.State = msoButtonUp Then
YourButton.State = msoButtonDown
Else
YourButton.State = msoButtonUp
End If
If objItem.ReadReceiptRequested = False Then
objItem.ReadReceiptRequested = True
' button action off
Else
objItem.ReadReceiptRequested = False
End If
End If
End If
End If
Set objInsp = Nothing
Set objItem = Nothing
End Sub
'CLASS MODULE (cInspector)
Private WithEvents m_oInspector As Outlook.Inspector
Private WithEvents m_oMailItem As Outlook.MailItem
Private WithEvents YourButton As Office.CommandBarButton
Private WithEvents YourButton1 As Office.CommandBarButton
Private m_lKey As Long
Friend Function Init(oInspector As Outlook.Inspector, ByVal lKey As Long) As
Boolean
Set m_oInspector = oInspector
Set m_oMailItem = oInspector.CurrentItem
If m_oMailItem.Sent = False Then
m_lKey = lKey
CreateButton oInspector
CreateButton1 oInspector
Init = True
End If
End Function
Private Sub CreateButton(Inspector As Outlook.Inspector)
Dim objCB As Office.CommandBar
Dim colCB As Office.CommandBars
Dim objPicture As stdole.IPictureDisp
Dim objMask As stdole.IPictureDisp
Const PICTURE_PATH As String = "C:\Documents and
Settings\drhyase\Icons\readreceipt.bmp"
Const PICTURE_MASK As String = "C:\Documents and
Settings\drhyase\Icons\readreceiptmask.bmp"
Set colCB = Inspector.CommandBars
Set objCB = colCB.Item("Standard")
Set colCBcontrols = objCB.Controls
Set YourButton = colCBcontrols.Add(msoControlButton, , "Standard", ,
True)
Set objPicture = LoadPicture(PICTURE_PATH)
Set objMask = LoadPicture(PICTURE_MASK)
With YourButton
.Caption = "&Read Receipt"
.Move Before:=3
.TooltipText = "Add/Remove a Read Receipt"
.Picture = objPicture
.Mask = objMask
.Style = msoButtonIconAndCaption
End With
Set objCB = Nothing
Set objCB = Nothing
End Sub
Private Sub CreateButton1(Inspector As Outlook.Inspector)
Dim objCB As Office.CommandBar
Dim colCB As Office.CommandBars
Set colCB = Inspector.CommandBars
Set objCB = colCB.Item("Standard")
Set colCBcontrols = objCB.Controls
Set YourButton1 = colCBcontrols.Add(msoControlButton, , "Standard",
, True)
With YourButton1
.Caption = "Save Copy"
.Move Before:=4
.TooltipText = "Save in Sent Items Folder"
.Style = msoButtonCaption
End With
Set objCB = Nothing
Set objCB = Nothing
End Sub
Friend Sub CloseInspector()
On Error Resume Next
Application.RemoveInspector m_lKey
Set YourButton = Nothing
Set YourButton1 = Nothing
Set m_oMailItem = Nothing
Set m_oInspector = Nothing
End Sub
Private Sub m_oInspector_Close()
CloseInspector
End Sub
Private Sub m_oMailItem_Close(Cancel As Boolean)
If m_oMailItem.Saved Then
CloseInspector
End If
End Sub
Private Sub m_oMailItem_Send(Cancel As Boolean)
CloseInspector
End Sub
Private Sub YourButton_Click1(ByVal Ctrl As Office.CommandBarButton,
CancelDefault As Boolean)
Dim objInsp1 As Outlook.Inspector
Dim objItem1 As MailItem
' get the currently open item and make sure it's a mail message
Set objInsp1 = Application.ActiveInspector
If Not objInsp1 Is Nothing Then
Set objItem1 = objInsp1.CurrentItem
If objItem1.Class = olMail Then
' make sure it's unsent
If objItem1.Sent = False Then
' button action on
If YourButton1.State = msoButtonUp Then
YourButton1.State = msoButtonDown
Else
YourButton1.State = msoButtonUp
End If
If objItem1.DeleteAfterSubmit = False Then
objItem1.DeleteAfterSubmit = True
' button action off
Else
objItem1.DeleteAfterSubmit = False
End If
End If
End If
End If
Set objInsp1 = Nothing
Set objItem1 = Nothing
End Sub
Private Sub YourButton_Click(ByVal Ctrl As Office.CommandBarButton,
CancelDefault As Boolean)
Dim objInsp As Outlook.Inspector
Dim objItem As MailItem
' get the currently open item and make sure it's a mail message
Set objInsp = Application.ActiveInspector
If Not objInsp Is Nothing Then
Set objItem = objInsp.CurrentItem
If objItem.Class = olMail Then
' make sure it's unsent
If objItem.Sent = False Then
' button action on
If YourButton.State = msoButtonUp Then
YourButton.State = msoButtonDown
Else
YourButton.State = msoButtonUp
End If
If objItem.ReadReceiptRequested = False Then
objItem.ReadReceiptRequested = True
' button action off
Else
objItem.ReadReceiptRequested = False
End If
End If
End If
End If
Set objInsp = Nothing
Set objItem = Nothing
End Sub
several months ago that works great for adding Read Receipts. Now, I'd like
to add another button that allows me to select whether I save a copy in the
Sent Items folder. I figured out the correct code for one button, but don't
know how to make it work so that both buttons function together. Any help?
'THIS OUTLOOK SESSION
Private WithEvents m_oInspector As Outlook.Inspector
Private WithEvents m_oMailItem As Outlook.MailItem
Private WithEvents YourButton As Office.CommandBarButton
Private WithEvents YourButton1 As Office.CommandBarButton
Private m_lKey As Long
Friend Function Init(oInspector As Outlook.Inspector, ByVal lKey As Long) As
Boolean
Set m_oInspector = oInspector
Set m_oMailItem = oInspector.CurrentItem
If m_oMailItem.Sent = False Then
m_lKey = lKey
CreateButton oInspector
CreateButton1 oInspector
Init = True
End If
End Function
Private Sub CreateButton(Inspector As Outlook.Inspector)
Dim objCB As Office.CommandBar
Dim colCB As Office.CommandBars
Dim objPicture As stdole.IPictureDisp
Dim objMask As stdole.IPictureDisp
Const PICTURE_PATH As String = "C:\Documents and
Settings\drhyase\Icons\readreceipt.bmp"
Const PICTURE_MASK As String = "C:\Documents and
Settings\drhyase\Icons\readreceiptmask.bmp"
Set colCB = Inspector.CommandBars
Set objCB = colCB.Item("Standard")
Set colCBcontrols = objCB.Controls
Set YourButton = colCBcontrols.Add(msoControlButton, , "Standard", ,
True)
Set objPicture = LoadPicture(PICTURE_PATH)
Set objMask = LoadPicture(PICTURE_MASK)
With YourButton
.Caption = "&Read Receipt"
.Move Before:=3
.TooltipText = "Add/Remove a Read Receipt"
.Picture = objPicture
.Mask = objMask
.Style = msoButtonIconAndCaption
End With
Set objCB = Nothing
Set objCB = Nothing
End Sub
Private Sub CreateButton1(Inspector As Outlook.Inspector)
Dim objCB As Office.CommandBar
Dim colCB As Office.CommandBars
Set colCB = Inspector.CommandBars
Set objCB = colCB.Item("Standard")
Set colCBcontrols = objCB.Controls
Set YourButton1 = colCBcontrols.Add(msoControlButton, , "Standard",
, True)
With YourButton1
.Caption = "Save Copy"
.Move Before:=4
.TooltipText = "Save in Sent Items Folder"
.Style = msoButtonCaption
End With
Set objCB = Nothing
Set objCB = Nothing
End Sub
Friend Sub CloseInspector()
On Error Resume Next
Application.RemoveInspector m_lKey
Set YourButton = Nothing
Set YourButton1 = Nothing
Set m_oMailItem = Nothing
Set m_oInspector = Nothing
End Sub
Private Sub m_oInspector_Close()
CloseInspector
End Sub
Private Sub m_oMailItem_Close(Cancel As Boolean)
If m_oMailItem.Saved Then
CloseInspector
End If
End Sub
Private Sub m_oMailItem_Send(Cancel As Boolean)
CloseInspector
End Sub
Private Sub YourButton_Click1(ByVal Ctrl As Office.CommandBarButton,
CancelDefault As Boolean)
Dim objInsp1 As Outlook.Inspector
Dim objItem1 As MailItem
' get the currently open item and make sure it's a mail message
Set objInsp1 = Application.ActiveInspector
If Not objInsp1 Is Nothing Then
Set objItem1 = objInsp1.CurrentItem
If objItem1.Class = olMail Then
' make sure it's unsent
If objItem1.Sent = False Then
' button action on
If YourButton1.State = msoButtonUp Then
YourButton1.State = msoButtonDown
Else
YourButton1.State = msoButtonUp
End If
If objItem1.DeleteAfterSubmit = False Then
objItem1.DeleteAfterSubmit = True
' button action off
Else
objItem1.DeleteAfterSubmit = False
End If
End If
End If
End If
Set objInsp1 = Nothing
Set objItem1 = Nothing
End Sub
Private Sub YourButton_Click(ByVal Ctrl As Office.CommandBarButton,
CancelDefault As Boolean)
Dim objInsp As Outlook.Inspector
Dim objItem As MailItem
' get the currently open item and make sure it's a mail message
Set objInsp = Application.ActiveInspector
If Not objInsp Is Nothing Then
Set objItem = objInsp.CurrentItem
If objItem.Class = olMail Then
' make sure it's unsent
If objItem.Sent = False Then
' button action on
If YourButton.State = msoButtonUp Then
YourButton.State = msoButtonDown
Else
YourButton.State = msoButtonUp
End If
If objItem.ReadReceiptRequested = False Then
objItem.ReadReceiptRequested = True
' button action off
Else
objItem.ReadReceiptRequested = False
End If
End If
End If
End If
Set objInsp = Nothing
Set objItem = Nothing
End Sub
'CLASS MODULE (cInspector)
Private WithEvents m_oInspector As Outlook.Inspector
Private WithEvents m_oMailItem As Outlook.MailItem
Private WithEvents YourButton As Office.CommandBarButton
Private WithEvents YourButton1 As Office.CommandBarButton
Private m_lKey As Long
Friend Function Init(oInspector As Outlook.Inspector, ByVal lKey As Long) As
Boolean
Set m_oInspector = oInspector
Set m_oMailItem = oInspector.CurrentItem
If m_oMailItem.Sent = False Then
m_lKey = lKey
CreateButton oInspector
CreateButton1 oInspector
Init = True
End If
End Function
Private Sub CreateButton(Inspector As Outlook.Inspector)
Dim objCB As Office.CommandBar
Dim colCB As Office.CommandBars
Dim objPicture As stdole.IPictureDisp
Dim objMask As stdole.IPictureDisp
Const PICTURE_PATH As String = "C:\Documents and
Settings\drhyase\Icons\readreceipt.bmp"
Const PICTURE_MASK As String = "C:\Documents and
Settings\drhyase\Icons\readreceiptmask.bmp"
Set colCB = Inspector.CommandBars
Set objCB = colCB.Item("Standard")
Set colCBcontrols = objCB.Controls
Set YourButton = colCBcontrols.Add(msoControlButton, , "Standard", ,
True)
Set objPicture = LoadPicture(PICTURE_PATH)
Set objMask = LoadPicture(PICTURE_MASK)
With YourButton
.Caption = "&Read Receipt"
.Move Before:=3
.TooltipText = "Add/Remove a Read Receipt"
.Picture = objPicture
.Mask = objMask
.Style = msoButtonIconAndCaption
End With
Set objCB = Nothing
Set objCB = Nothing
End Sub
Private Sub CreateButton1(Inspector As Outlook.Inspector)
Dim objCB As Office.CommandBar
Dim colCB As Office.CommandBars
Set colCB = Inspector.CommandBars
Set objCB = colCB.Item("Standard")
Set colCBcontrols = objCB.Controls
Set YourButton1 = colCBcontrols.Add(msoControlButton, , "Standard",
, True)
With YourButton1
.Caption = "Save Copy"
.Move Before:=4
.TooltipText = "Save in Sent Items Folder"
.Style = msoButtonCaption
End With
Set objCB = Nothing
Set objCB = Nothing
End Sub
Friend Sub CloseInspector()
On Error Resume Next
Application.RemoveInspector m_lKey
Set YourButton = Nothing
Set YourButton1 = Nothing
Set m_oMailItem = Nothing
Set m_oInspector = Nothing
End Sub
Private Sub m_oInspector_Close()
CloseInspector
End Sub
Private Sub m_oMailItem_Close(Cancel As Boolean)
If m_oMailItem.Saved Then
CloseInspector
End If
End Sub
Private Sub m_oMailItem_Send(Cancel As Boolean)
CloseInspector
End Sub
Private Sub YourButton_Click1(ByVal Ctrl As Office.CommandBarButton,
CancelDefault As Boolean)
Dim objInsp1 As Outlook.Inspector
Dim objItem1 As MailItem
' get the currently open item and make sure it's a mail message
Set objInsp1 = Application.ActiveInspector
If Not objInsp1 Is Nothing Then
Set objItem1 = objInsp1.CurrentItem
If objItem1.Class = olMail Then
' make sure it's unsent
If objItem1.Sent = False Then
' button action on
If YourButton1.State = msoButtonUp Then
YourButton1.State = msoButtonDown
Else
YourButton1.State = msoButtonUp
End If
If objItem1.DeleteAfterSubmit = False Then
objItem1.DeleteAfterSubmit = True
' button action off
Else
objItem1.DeleteAfterSubmit = False
End If
End If
End If
End If
Set objInsp1 = Nothing
Set objItem1 = Nothing
End Sub
Private Sub YourButton_Click(ByVal Ctrl As Office.CommandBarButton,
CancelDefault As Boolean)
Dim objInsp As Outlook.Inspector
Dim objItem As MailItem
' get the currently open item and make sure it's a mail message
Set objInsp = Application.ActiveInspector
If Not objInsp Is Nothing Then
Set objItem = objInsp.CurrentItem
If objItem.Class = olMail Then
' make sure it's unsent
If objItem.Sent = False Then
' button action on
If YourButton.State = msoButtonUp Then
YourButton.State = msoButtonDown
Else
YourButton.State = msoButtonUp
End If
If objItem.ReadReceiptRequested = False Then
objItem.ReadReceiptRequested = True
' button action off
Else
objItem.ReadReceiptRequested = False
End If
End If
End If
End If
Set objInsp = Nothing
Set objItem = Nothing
End Sub