Outlook: Defer & Context menu on toolbar

[gunns256]

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(strCom mandBarName).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(strCom mandBarName).Controls
_
'<- For Outlook
' For Each objCommandBarControl In _
' Application.VBE.CommandBars.Item(strCommandBarName ).Controls _
<- For Visual Basic Editor
'For Each objCommandBarControl In Application.CommandBars.Item(strCommandBarName).Co ntrols

If objCommandBarControl.Caption = strComboBoxCaption Then

objCommandBarControl.Delete

End If

Next objCommandBarControl

' Create the combo box.
' Replace the next line of code with:
' Set objCommandBarComboBox = _
' Application.CommandBars.Item(strCommandBarName).Co ntrols.Add(msoControlComboBox) _
<- For Outlook
' Set objCommandBarComboBox = _
' Application.CommandBars.Item(strCommandBarName).Co ntrols.Add(msoControlComboBox) _
<- For Visual Basic Editor
Set objCommandBarComboBox = _
Application.ActiveExplorer.CommandBars.Item(strCom mandBarName).Controls.Add(msoControlComboBox)

objCommandBarComboBox.Caption = strComboBoxCaption

For Each varChoice In strChoices

objCommandBarComboBox.AddItem varChoice

Next varChoice

If strComboBoxCaption = "Defer" Then
objCommandBarComboBox.Text = "Defer"
objCommandBarComboBox.Width = 100
objCommandBarComboBox.OnAction = "SelectionAction"
End If
If strComboBoxCaption = "Context" Then
objCommandBarComboBox.Text = "Context"
objCommandBarComboBox.Width = 100
objCommandBarComboBox.OnAction = "SelectionAction"
End If
AddComboBoxToCommandBar_End:

AddComboBoxToCommandBar = True
Exit Function

AddComboBoxToCommandBar_Err:

AddComboBoxToCommandBar = False
MsgBox ("addcomboboxtocommandbar.error")

End Function
'called from This Outlook Session, adds comboboxes by calling 'AddComboBoxToCommandBar
Public Sub TestAddComboBoxToCommandBar()
Set mynamespace = Application.GetNamespace("MAPI")
Set myfolders = mynamespace.Folders
Set myfolder = myfolders.Item(1).Folders.Item("Projects")
Dim projcollection As Collection
Dim strChoices() As String
ReDim strChoices(6)
'change number if you want more/less items
strChoices(1) = "Defer"
strChoices(2) = "1 week"
strChoices(3) = "1 month"
strChoices(4) = "End June"
strChoices(5) = "End August"
strChoices(6) = "None"
Call AddComboBoxToCommandBar("Advanced", "Defer", strChoices)
ReDim strChoices(11)
strChoices(1) = "Context"
strChoices(2) = "@Agenda"
strChoices(3) = "@Computer"
strChoices(4) = "@Errand"
strChoices(5) = "@Home"
strChoices(6) = "@Phone"
strChoices(7) = "@School"
strChoices(8) = "@Transfer"
strChoices(9) = "@Waiting"
strChoices(10) = "<Someday"
strChoices(11) = ">Goals"
Call AddComboBoxToCommandBar("Advanced", "Context", strChoices)
Set myfolder = Nothing
Set myfolders = Nothing
Set mynamespace = Nothing
End Sub

[Fiona]

Hi there

I get an 'the operation failed. the object cannot be found at this line

Set myfolder = myfolders.Item(1).Folders.Item("Projects")

Any ideas??

[bdesilva]

I don't even get what I expect to be a toolbar button on the advanced toolbar. Help?

[gunns256]

OK.

Fiona, the operation failed.

I cut and pasted this from a larger project. This line should be deleted. It will fail if you don't have a folder "Projects."

bdesilva, do you get anything on your toolbar? I have two comboboxes: one named "Defer" and one named "Contexts."

[gunns256]

If you have the vb editor open, you can put the cursor in the testaddcomboboxtocommandbar sub and either press f5 or else click run.

If this successfully creates two comboboxes on the "Advanced" commandbar, then you're a winner (at least until you try to use them). You will have to adjust my @context names to match up with yours. You might also wish to change my "Defer" times.

I'm going to bed soon. I'll check back tomorrow am early.

gunns256

[gunns256]

Continuing with my "documentation as afterthought" riff, the functionality of these is to select a task or group of tasks, use the combobox, and either change the due date or else change the context.

[bdesilva]

I don't get anything at all. I added the code to Module1. I do have other code there might that be a problem?

Bryan

[bdesilva]

This is weird. I just ran the macro as you suggested manually w/F5. I get a dialog box saying macros in this project are disabled. The help says to close it and choose enable macros when re-loading. I don't get that prompt... I assume it's like the one Excel shows when loading. I also haven't turned them off anywhere on my system. Help?

[bdesilva]

OK. I found that somehow my Macro security got set to high. Now it's medium and I did the F5 thing on the sub in "ThisOutlookSession. I get the message, "Compile Error: Syntax Error"

and this line is highlighted yellow in Module1.

Public Sub TestAddComboBoxToCommandBar()

[gunns256]

Hello, Brian.

I regret that this is so annoying. And I won't ever again post any code impulsively. I will guarantee that this code works on my device.

Now about you: good that you have security set. After it gets running you'll be able to reset security to high.

Try having the cursor within that Testaddcomboboxtocommandbar routine before pressing f5.

Please read my post to Fiona about deleting the line about .Folders("Projects")

A possible source of compile errors is cutting and pasting from the forum: if lines break un-naturally, then the code won't compile.

I won't be able to check in again till about 5 EDT

[bdesilva]

OK. I fixed one formatting problem I found. Now the compile error is at

Private Function AddComboBoxToCommandBar(ByVal strCommandBarName As String, _
ByVal strComboBoxCaption As String, _
ByRef strChoices() As String) As Boolean

This is three lines in my system. I assume the underscore is a continuation character?

[bdesilva]

One more step. Now it works to create the combo boxes. When I choose a task and choose Defer 1 week it fails at

Call UpdateProject(objSelection)

Looking through the project I don't find this function anywhere. I have created a top level projects folder but don't know what it's used for yet.

Bryan

[gunns256]

I'm glad you got it working.

You won't need the folder "Projects" if you delete the line mentioned in the post to Fiona; it's a nonfunctional (for you) folder which is served by a different set of macros; I mistakenly copied the reference when I was cutting and pasting this code.

What's the point of all this?

In a large task list, when all tasks are dated, you may wish to select some of them and defer them to another time. If you have tasks selected, then Defer/Next Week should change the due date to due date + 7 days. Of course you can modify my code to meet your own needs--you may not want to defer anything until the end of June because you aren't a teacher.

Contexts will serve a similar function. You will need categories named as my contexts--@Computer, @Home, @School and so on, or else you will need to modify the code so it matches your categories. I'll be happy to help.

EFG