Link to home
Start Free TrialLog in
Avatar of mrp24923
mrp24923

asked on

Outlook 2000 - VBA code to emulate "Out of Office" assistant?

Hi, I'm managing the email for a small family run business. Everyone has Outlook 2000.  I went to show them how to turn on the "Out of office" auto-responder the other day, but to my great surprise Outlook 2000 doesn't have this feature.  Apparently even 2003 doesn't have it either!   I don't particularly want to tell them to upgrade all their computers to 2007 just for this feature.  So was wondering if there's an easy alternative.  I know I could just create an autoresponding Rule, and tell them to turn it on when they're away, but I fear this wouldn't be user-friendly enough for some of the users.

So I was thinking someone might be able to program something in VBA for Outlook?

Here's what I'd like specifically

An "Out of office" button on the toolbar.  When you click it a window pops up asking what you want your Out of office message to be.  The default is what the message was last time (if that's possible).  Hit OK or cancel.  If you hit "ok", the pop-up is replaced by another that says "Out of office" assistant is ON.  Do not close Outlook."  And then have a button to press when one wants to stop the assistant.  You could also make it impossible to close Outlook while the assistant is running, if that's possible.

Can anyone do this?

Thanks.  And I'm a bit familiar with VBA and even know of "Redemption" so you wouldn't have to baby-step me too much on usage...
Avatar of David Lee
David Lee
Flag of United States of America image

Hi, mrp24923.

Both Outlook 2000 and 2003 have the Out of Office feature.  The reason you don't see it is because the option is only available if your mail is on an Exchange server.  That's because Out of Office sends the response from the Exchange server, not from Outlook.  It is possible to emulate this feature using VBA, but there's no need to do that.  You can achieve the same effect with a rule.  In both case, i.e. using VBA to emulate or a rule, the computer has to be left on with Outlook open for it to be able to reply.
Avatar of mrp24923
mrp24923

ASKER

Yeah, our mail isn't on an Exchange server unfortunately.  

I read about emulating the Outlook assistant with a rule, but I just think it'd be too complicated for the likes of my Grandma and Grampa to modify a separate text file each time they want to change the Out of Office message.  And I could do it for them I suppose, but I'd rather they be self-sufficient...

Needing to leave Outlook open the whole time would be fine.

Okay.  I'll put together some code and post it as soon as I can.
How about a slight change to the way you proposed doing this?  Here's what I have in mind.  The only function VBA has for entering text is InputBox.  That produces a dialog-box with a single line text box for entering text.  It's unattractive, the text has to be entered all on one line (so if it's long you have to scroll back and forth), there's no spell checking, etc.  Te alternative is to create userform and use a a text-box control.  That gives multiline input, but it still isn't attractive and there's still no spell checking, etc.  There's also the question of where to store the out of office message once entered.  Yes, we could write it to a text file, but then it has to be read back in each time which slows the system down.  We could just keep it in memory, but then when Outlook is shutdown the message would be lost.  Here's what I have in mind.  Let's create a folder called "Out of Office".  When you turn OOO on the code will display a standard Outlook Post form.  Entering the message will be as simple writing a message and you'll have all the same features available as when you write a message.  Fonts, colors, spellchecking, even images/graphics if you want to use them.  The contents of the post will be saved to the "Out of Office" folder.  When OOO is on and a message is received, the code will create a reply pulling the body of the reply from that post.  Will that work?
Yes, that sounds like a good way to do it BlueDevilFan.  Thank you.
Part 1 of 3

Follow these instructions to add this code to Outlook.

1.  Start Outlook
2.  Click Tools > Macro > Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects
4.  Right-click on Class Modules, select Insert > Class Module
5.  In the Properties panel click on Name and enter OOOmanager
6.  Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook's VB Editor window
7.  Edit the code as needed.  I included comments wherever something needs to or can change
8.  Click the diskette icon on the toolbar to save the changes
9.  Close the VB Editor


'*** Constants
Const CLASSNAME = "OOOmanager"
Const OOO_FOLDER_PATH = "David\OOO" '<- Change the folder path'
 
'*** Enumerations
Private Enum ooomState
    ooomOff = 0
    ooomOn = 1
End Enum
 
'*** Class Variables
Private WithEvents olkInbox As Outlook.Items
Private intState As ooomState, _
    olkOOOFolder As Outlook.MAPIFolder, _
    olkOOOMessage As Outlook.PostItem, _
    bolTesting As Boolean
 
Private Sub Class_Initialize()
    If FolderExists(OOO_FOLDER_PATH) Then
        Set olkOOOFolder = Me.OpenOutlookFolder(OOO_FOLDER_PATH)
    Else
        Set olkOOOFolder = MakeFolder(OOO_FOLDER_PATH, olFolderInbox)
    End If
End Sub
 
Private Sub Class_Terminate()
    Set olkOOOFolder = Nothing
End Sub
 
Public Sub Activate()
    Dim olkTemp As Outlook.PostItem, strSubject As String, strMessage As String
    If olkOOOFolder.Items.Count = 1 Then
        Set olkTemp = olkOOOFolder.Items.Item(1)
        strSubject = olkTemp.Subject
        strMessage = olkTemp.HTMLBody
        olkTemp.Delete
    Else
        strSubject = "Out of Office"
        strMessage = "Enter your message, then click the Post button."
    End If
    Set olkOOOMessage = olkOOOFolder.Items.Add(olPostItem)
    With olkOOOMessage
        .Subject = strSubject
        .HTMLBody = strMessage
    End With
    olkOOOMessage.Display True
    Set olkInbox = Outlook.Session.GetDefaultFolder(olFolderInbox).Items
    intState = ooomOn
End Sub
 
Public Sub Deactivate()
    Set olkInbox = Nothing
    intState = ooomOff
End Sub
 
Public Sub TestMode(bolMode As Boolean)
    bolTesting = bolMode
End Sub
 
Function FolderExists(strFolderPath As String) As Boolean
    ' Purpose: Tests to see if an Outlook folder exists based on a path string.'
    ' Written: 4/24/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: All versions'
    FolderExists = (TypeName(OpenOutlookFolder(strFolderPath)) <> "Nothing")
End Function
 
Function MakeFolder(strPath As String, intType As OlDefaultFolders) As Outlook.Folder
    ' Purpose: Create a folder from a folder path.'
    ' Written: 4/24/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: 2007'
    Dim arrFolders As Variant, _
        olkFolder As Outlook.Folder, _
        intIndex As Integer
    arrFolders = Split(strPath, "\")
    Set olkFolder = Session.Stores.Item(arrFolders(0)).GetRootFolder
    For intIndex = 1 To UBound(arrFolders)
        If FolderExists(olkFolder.FolderPath & "\" & arrFolders(intIndex)) Then
            Set olkFolder = olkFolder.Folders.Item(arrFolders(intIndex))
        Else
            Set olkFolder = olkFolder.Folders.Add(arrFolders(intIndex), intType)
        End If
    Next
    Set MakeFolder = olkFolder
    Set olkFolder = Nothing
End Function
 
Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
    ' Purpose: Opens an Outlook folder from a folder path.'
    ' Written: 4/24/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: All versions'
    Dim arrFolders As Variant, _
        varFolder As Variant, _
        bolBeyondRoot As Boolean
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            Select Case bolBeyondRoot
                Case False
                    Set OpenOutlookFolder = Outlook.Session.Folders(varFolder)
                    bolBeyondRoot = True
                Case True
                    Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
            End Select
            If Err.Number <> 0 Then
                Set OpenOutlookFolder = Nothing
                Exit For
            End If
        Next
    End If
    On Error GoTo 0
End Function
 
Sub olkInbox_ItemAdd(ByVal Item As Object)
    Dim olkReply As Outlook.MailItem, olkTemp As Outlook.MailItem
    If intState = ooomOn Then
        If Item.Class = olMail Then
            Set olkTemp = Item.Reply
            Set olkReply = Outlook.Application.CreateItem(0)
            With olkReply
                .Recipients.Add olkTemp.Recipients.Item(1)
                .Subject = "Out of Office"
                .HTMLBody = olkOOOMessage.HTMLBody
                If bolTesting Then
                    .Save
                Else
                    .Send
                End If
            End With
        End If
    End If
    Set olkTemp = Nothing
    Set olkReply = Nothing
End Sub

Open in new window

Part 2 of 3

Follow these instructions to add this code to Outlook.

1.  Start Outlook
2.  Click Tools > Macro > Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects and click on ThisOutlookSession
4.  Copy the code from the Code Snippet box and paste it into the right-hand pane of
5.  Outlook's VB Editor window
6.  Edit the code as needed.  I included comment lines wherever something needs to or can change
7.  Click the diskette icon on the toolbar to save the changes
8.  Close the VB Editor
9.  Click Tools > Macro > Security
10. Set the Security Level to Medium
11. Close Outlook
12. Start Outlook
13. Outlook will display a dialog-box warning that ThisOutlookSession contains macros and asking if you want to allow them to run.  Say yes.

Dim olkOOO As OOOmanager
 
Private Sub Application_Quit()
    olkOOO.Deactivate
    Set olkOOO = Nothing
End Sub
 
Private Sub Application_Startup()
    Set olkOOO = New OOOmanager
End Sub

Open in new window

Part 3 of 3

Follow these instructions to add this code to Outlook.

1.  Start Outlook
2.  Click Tools > Macro > Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects
4.  If not already expanded, expand Modules
5.  Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert > Module.
6.  Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook's VB Editor window
7.  Edit the code as needed.  I included comments wherever something needs to or can change
8.  Click the diskette icon on the toolbar to save the changes
9.  Close the VB Editor

Sub ActivateOOO()
    With olkOOO
        .TestMode True
        .Activate
    End With
End Sub
 
Sub DeactivateOOO()
    olkOOO.Deactivate
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of David Lee
David Lee
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thank you!  Though, I'm getting the following error message, I'm afraid:

Compile Error
User-defined type not defined

And the following line of code is highlighted:
Function MakeFolder(strPath As String, intType As OlDefaultFolders) As Outlook.Folder

I've also attached a screenshot of this.

Is there a library I may be missing or something?
compile-error.gif
Sorry, those routines are general routines that I use in a lot of questions.  They're written for Outlook 2007 not 2000.  Change all instances of

    Outlook.Folder

to

    Outlook.MAPIFolder
Sorry, now I'm getting another error:

Run-time error '438'
Object doesn't support this property or method

On the following line of code:

Set olkOOO = New OOOmanager
Did you follow all the instructions in part 1?  Is there a class module named OOOmanager?
Yes, I followed the instructions carefully, and created the class module named OOOmodule.  I've attached a  screenshot so you can see how it's set up, and make sure I've done it properly.

By the way, I'm also getting the error when using Outlook 2007, so I know it's not just an Outlook 2000 caused error.
outlook-problem.gif
I took a look at the image you posted and the first thing I notice is that you haven't changed the folder path in the OOOmanager class module.  Instruction #7 of the instructions for the class module says "Edit the code as needed.  I included comments wherever something needs to or can change"  and there is a comment on that line that says "Change the folder path".  That path has to give the name of the PST file and folder where the code will store the OOO message.  The folder does not have to exist, the code will create it if it doesn't.  For example, if you want the OOO message to be stored in a folder called "OOO" in a PST file named "Personal Folders", then you'd edit that line of code replacing "David\OOO" with "Personal Folders\OOO".
But that shouldn't be the problem right?  It doesn't really matter what the folder is named, and if it doesn't exist it'll just create it.  But just in case I changed the path to C:\outlook, and created that directory manually.  

But that doesn't fix the problem, unfortunately.

This is really odd.  Sometimes when I open outlook (I'm testing with 2007 at the moment), upon startup, I get the following error:

"The operation failed.  An object could not be found."

And the following line is highlighted:
"Set olkOOO = New OOOmanager"

And sometimes I don't.  But whenever I press the button to activate OOO, I always get the error:

"Object Required"

And the following line is highlighted:
".TestMode True"

It definitely seems the class module isn't declaring properly somehow.

Any ideas?
"But that shouldn't be the problem right?"
No, unfortunately that is a problem.

"It doesn't really matter what the folder is named"
Correct, but the code cannot create the folder, in this case OOO, in a non-existent location.  You almost certainly do not have a pst file named "David".  The code is trying to check for the existence of "OOO" in a .pst file named "David".  It's failing because there is no such pst file.  

"But just in case I changed the path to C:\outlook, and created that directory manually."
That won't help.  You created a file system folder, which has nothing to do with Outlook folders.  

Change "David" to the name of an existing personal folders entry.  Assume that when you look at Outlook's navigation pane you see something like this:

Personal Folders
    Deleted Items
    Drafts
    Inbox
    Junk E-mail
    Outbox
    Sent Items
Archive File
    Deleted Items

The entries "Personal Folders" and "Archive File" both represent personal folder entries.  You could change "David" to either of those names and the code would work.
Ah I totally misunderstood.  Sorry about that.  I've now changed the code so the FOLDER PATH is
"Personal Folders\ooo".  This seems to work fine as I see the folder "ooo" was created within Outlook, and I'm no longer receiving that error message upon startup.

But I'm sorry to report I'm still receiving the following error upon activating the code:

"Object Required"

And the following line is highlighted:
".TestMode True"

"Object Required" means that line #9 of the code in part 2 is failing.  It isn't creating the class.  The most likely cause is that the folder path is still invalid.  What do you have on line #3 of the code in part 1?
Const OOO_FOLDER_PATH = "Personal Folders\ooo" '<- Change the folder path'

I think that's working ok, because it created the folder "ooo" within Outlook.
Good deal!