Assumes existence of toolbar "Advanced"
Don't have one? Create one. Tools/Customize/Toolbars...New...
The code I am posting is unconventional: I'm using Outlook 2000 on an old machine, and I find that Outlook has become a memory pig with my 370 tasks and so on... I find that fewer object variables improves performance.
Alt-F11 to enter VB editor
double-click on left pane: folder Microsoft Outlook Objects
double-click on "This Outlook Session"
Paste this code (3 lines) which will run at every Outlook Startup:
Private Sub Application_Startup()
TestAddComboboxtoCommandBar
End Sub
Insert/Module if you've never coded before.
Paste this code (here to end) into the new module:
Sub UpdateContext(objSel As Selection)
Dim objItem As Object
Dim mycategory As String
mycategory = Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Context").Text
'MsgBox (mycategory)
Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Context").Text = "Context"
For Each objItem In objSel
If objItem.Class = olTask Then
objItem.Categories = ""
objItem.Categories = mycategory
objItem.Save
Else
MsgBox (objItem.Class)
End If
Next
Set objItem = Nothing
End Sub
Sub UpdateDefer(objSel As Selection)
Dim objItem As Object
Dim strdeferdate As String
Dim mydate As Date
strdeferdate = Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Defer").Text
Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Defer").Text = "Defer"
'MsgBox (strdeferdate)
For Each objItem In objSel
mydate = objItem.DueDate
If mydate = #1/1/4501# Then mydate = Date
If objItem.Class = olTask Then
If strdeferdate = "None" Then
objItem.DueDate = #1/1/4501# 'esoterica. look it up.
Else
'these are good for me because I'm a teacher
If strdeferdate = "1 week" Then mydate = DateAdd("ww", 1, mydate)
If strdeferdate = "1 month" Then mydate = DateAdd("m", 1, mydate)
If strdeferdate = "End June" Then mydate = DateValue("6/25")
If strdeferdate = "End August" Then mydate = DateValue("8/25")
If mydate < Date Then mydate = mydate + 365
objItem.DueDate = mydate
End If
objItem.Save
Else
MsgBox (objItem.Class)
End If
Next
Set objItem = Nothing
End Sub
Private Function SelectionAction()
Dim objSelection As Selection
Dim blnDoIt As Boolean
Dim intMaxItems As Integer
Dim intOKToExceedMax As Integer
Dim strMsg As String
intMaxItems = 5
Set objSelection = Application.ActiveExplorer.Selection
Select Case objSelection.Count
Case 0
strMsg = "No items were selected"
MsgBox strMsg, , "No selection"
blnDoIt = False
Case Is > intMaxItems
strMsg = "You selected " & _
objSelection.Count & " items. " & _
"Do you really want to process " & _
"that large a selection?"
intOKToExceedMax = MsgBox( _
Prompt:=strMsg, _
Buttons:=vbYesNo + vbDefaultButton2, _
Title:="Selection exceeds maximum")
If intOKToExceedMax = vbYes Then
blnDoIt = True
Else
blnDoIt = False
End If
Case Else
blnDoIt = True
End Select
If blnDoIt = True Then
If Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Projects").Text "Projects" Then
Call UpdateProject(objSelection)
End If
If Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Defer").Text "Defer" Then
Call UpdateDefer(objSelection)
End If
If Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Context").Text "Context" Then
Call UpdateContext(objSelection)
End If
End If
Set objSelection = Nothing
'Set objApp = Nothing
End Function
Private Function AddComboBoxToCommandBar(ByVal strCommandBarName As String, _
ByVal strComboBoxCaption As String, _
ByRef strChoices() As String) As Boolean
' Purpose: Adds a combo box to a command bar.
' Accepts:
' strCommandBarName: The name of the command bar to add the combo box.
' strChoices(): An array of combo box choices.
' Returns: True if the combo box was successfully added to the command bar.
Dim objCommandBarControl As Office.CommandBarControl
Dim objCommandBarComboBox As Office.CommandBarComboBox
Dim varChoice As Variant
On Error GoTo AddComboBoxToCommandBar_Err
Application.ActiveExplorer.CommandBars.Item(strCommandBarName).Visible = True
' Delete any previously-added instances of this combo box.
' Replace the next line of code with:
For Each objCommandBarControl In _
Application.ActiveExplorer.CommandBars.Item(strCommandBarName).Controls
_
'
Don't have one? Create one. Tools/Customize/Toolbars...New...
The code I am posting is unconventional: I'm using Outlook 2000 on an old machine, and I find that Outlook has become a memory pig with my 370 tasks and so on... I find that fewer object variables improves performance.
Alt-F11 to enter VB editor
double-click on left pane: folder Microsoft Outlook Objects
double-click on "This Outlook Session"
Paste this code (3 lines) which will run at every Outlook Startup:
Private Sub Application_Startup()
TestAddComboboxtoCommandBar
End Sub
Insert/Module if you've never coded before.
Paste this code (here to end) into the new module:
Sub UpdateContext(objSel As Selection)
Dim objItem As Object
Dim mycategory As String
mycategory = Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Context").Text
'MsgBox (mycategory)
Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Context").Text = "Context"
For Each objItem In objSel
If objItem.Class = olTask Then
objItem.Categories = ""
objItem.Categories = mycategory
objItem.Save
Else
MsgBox (objItem.Class)
End If
Next
Set objItem = Nothing
End Sub
Sub UpdateDefer(objSel As Selection)
Dim objItem As Object
Dim strdeferdate As String
Dim mydate As Date
strdeferdate = Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Defer").Text
Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Defer").Text = "Defer"
'MsgBox (strdeferdate)
For Each objItem In objSel
mydate = objItem.DueDate
If mydate = #1/1/4501# Then mydate = Date
If objItem.Class = olTask Then
If strdeferdate = "None" Then
objItem.DueDate = #1/1/4501# 'esoterica. look it up.
Else
'these are good for me because I'm a teacher
If strdeferdate = "1 week" Then mydate = DateAdd("ww", 1, mydate)
If strdeferdate = "1 month" Then mydate = DateAdd("m", 1, mydate)
If strdeferdate = "End June" Then mydate = DateValue("6/25")
If strdeferdate = "End August" Then mydate = DateValue("8/25")
If mydate < Date Then mydate = mydate + 365
objItem.DueDate = mydate
End If
objItem.Save
Else
MsgBox (objItem.Class)
End If
Next
Set objItem = Nothing
End Sub
Private Function SelectionAction()
Dim objSelection As Selection
Dim blnDoIt As Boolean
Dim intMaxItems As Integer
Dim intOKToExceedMax As Integer
Dim strMsg As String
intMaxItems = 5
Set objSelection = Application.ActiveExplorer.Selection
Select Case objSelection.Count
Case 0
strMsg = "No items were selected"
MsgBox strMsg, , "No selection"
blnDoIt = False
Case Is > intMaxItems
strMsg = "You selected " & _
objSelection.Count & " items. " & _
"Do you really want to process " & _
"that large a selection?"
intOKToExceedMax = MsgBox( _
Prompt:=strMsg, _
Buttons:=vbYesNo + vbDefaultButton2, _
Title:="Selection exceeds maximum")
If intOKToExceedMax = vbYes Then
blnDoIt = True
Else
blnDoIt = False
End If
Case Else
blnDoIt = True
End Select
If blnDoIt = True Then
If Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Projects").Text "Projects" Then
Call UpdateProject(objSelection)
End If
If Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Defer").Text "Defer" Then
Call UpdateDefer(objSelection)
End If
If Application.ActiveExplorer.CommandBars.Item("Advanced").Controls.Item("Context").Text "Context" Then
Call UpdateContext(objSelection)
End If
End If
Set objSelection = Nothing
'Set objApp = Nothing
End Function
Private Function AddComboBoxToCommandBar(ByVal strCommandBarName As String, _
ByVal strComboBoxCaption As String, _
ByRef strChoices() As String) As Boolean
' Purpose: Adds a combo box to a command bar.
' Accepts:
' strCommandBarName: The name of the command bar to add the combo box.
' strChoices(): An array of combo box choices.
' Returns: True if the combo box was successfully added to the command bar.
Dim objCommandBarControl As Office.CommandBarControl
Dim objCommandBarComboBox As Office.CommandBarComboBox
Dim varChoice As Variant
On Error GoTo AddComboBoxToCommandBar_Err
Application.ActiveExplorer.CommandBars.Item(strCommandBarName).Visible = True
' Delete any previously-added instances of this combo box.
' Replace the next line of code with:
For Each objCommandBarControl In _
Application.ActiveExplorer.CommandBars.Item(strCommandBarName).Controls
_
'