• If you are new to these Forums, please take a moment to register using the fields above.


No announcement yet.

Outlook: Defer & Context menu on toolbar

  • Filter
  • Time
  • Show
Clear All
new posts

  • Outlook: Defer & Context menu on toolbar

    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()
    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("Advan ced").Controls.Item("Context").Text
    'MsgBox (mycategory)
    Application.ActiveExplorer.CommandBars.Item("Advan ced").Controls.Item("Context").Text = "Context"
    For Each objItem In objSel
    If objItem.Class = olTask Then
    objItem.Categories = ""
    objItem.Categories = mycategory
    MsgBox (objItem.Class)
    End If
    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("Advan ced").Controls.Item("Defer").Text
    Application.ActiveExplorer.CommandBars.Item("Advan ced").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.

    '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
    MsgBox (objItem.Class)
    End If
    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
    blnDoIt = False
    End If
    Case Else
    blnDoIt = True
    End Select
    If blnDoIt = True Then
    If Application.ActiveExplorer.CommandBars.Item("Advan ced").Controls.Item("Projects").Text <> "Projects" Then
    Call UpdateProject(objSelection)
    End If
    If Application.ActiveExplorer.CommandBars.Item("Advan ced").Controls.Item("Defer").Text <> "Defer" Then
    Call UpdateDefer(objSelection)
    End If
    If Application.ActiveExplorer.CommandBars.Item("Advan ced").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


    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 = True
    Exit Function


    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( = "@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

  • #2
    Error on opening macro with OL2003

    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??


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


      • #4
        I'm sorry, let's see if I can fix it.


        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."


        • #5
          Quick Testing

          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.



          • #6
            Oh yeah, the functionality

            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.


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



              • #8
                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?


                • #9
                  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()


                  • #10
                    Intermittently checking in...

                    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


                    • #11
                      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?


                      • #12
                        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.



                        • #13

                          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.