I have a user who wants to forward emails to an external email account during non business hours.  I have seen a vb script by BlueDevilFan that looks like it will work with a little modification.  Unfortunately, my vb is too weak to do the modifications myself.  Any help would be appreciated.

Times to forward emails are 5PM to 8AM.

From BlueDevilFan

Here's a VBA script, a macro, that'll do exactly what you've described.  To use it:
1.  Start Outlook
2.  Click Tools->Macro->Visual Basic Editor
3.  If not already expanded, expand Microsoft Outlook Objects in the Project pane, then click on ThisOutlookSession
4.  Copy the script below
5.  Paste the script into the right-hand pane of the VB Editor
6.  Edit the script making the changes as per the comments I included in the code
7.  Click the diskette icon on the toolbar to save the changes
8.  Close the VB Editor
9.  Click Tools->Macro->Security
10.  Set Security Level to Medium
11.  Close Outlook
12.  Start Outlook
13.  A dialog-box will appear telling you the ThisOutlookSession contains macros and asking if you want to enable them.  Say yes.
14.  Test the macro
15.  When the macro runs Outlook will present you with another dialog-box advising that a program is trying to access your mailbox and asking if you want to allow it to.  Say yes.
16.  If a message from the designated user, with the specified subject is in the mailbox, and if the time is currently between 9:00am and 5:00pm, then the message will be moved to the destination folder.  Otherwise, nothing will happen.
17.  Once you've verified that the macro works as expected, then you need to sign the macro to avoid having Outlook security warn you wach time the macro runs.  Here's a link to instructions on exactly how to go about doing that: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnoxpta/html/odc_dsvba.asp



'Script begins here
Private WithEvents objInboxItems As Items

Private Sub Application_Startup()
    Dim objNS As NameSpace
    Set objNS = Application.GetNamespace("MAPI")
    ' instantiate Items collections for folders we want to monitor
    Set objInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
    Set objNS = Nothing
End Sub

Private Sub Application_Quit()
    ' disassociate global objects declared WithEvents
    Set objInboxItems = Nothing
End Sub

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
    Dim olItems As Items, _
        olItem As Object, _
        olMailItem As MailItem, _
        olAttachmentItem As Attachment, _
        olDestinationFolder As Outlook.MAPIFolder, _
        bolSenderMatch As Boolean, _
        bolSubjectMatch As Boolean, _
        bolTimeMatch As Boolean
    'Change the MAPI folder path on the next line to that of your destination folder
    Set olDestinationFolder = OpenMAPIFolder("\eeBlueDevilFan\eeTesting")
    Set olItems = objInboxItems.Restrict("[Unread] = True")
    For Each olItem In olItems
        If olItem.Class = olMail Then
            Set olMailItem = olItem
            'Change the sender's name on the next line to the sender you want to key on
            bolSenderMatch = (olMailItem.SenderName = "eeBlueDevilFan")
            'Change eeTesting on the next line to the subject you want to key on
            bolSubjectMatch = (InStr(1, olMailItem.Subject, "eeTesting", vbTextCompare) > 0)
            'Change the times on the next line to those you want to use
            bolTimeMatch = (Time >= #9:00:00 AM#) And (Time <= #5:00:00 PM#)
            If bolSenderMatch And bolSubjectMatch And bolTimeMatch Then
                olMailItem.Move olDestinationFolder
            End If
        End If
    Next
End Sub

'Credit where credit is due.
'The code below is not mine.  I found it somewhere on the internet but do
'not remember where or who the author is.  The original author(s) deserves all
'the credit for these functions.
Function OpenMAPIFolder(szPath)
    Dim app, ns, flr, szDir, i
    Set flr = Nothing
    Set app = CreateObject("Outlook.Application")
    If Left(szPath, Len("\")) = "\" Then
        szPath = Mid(szPath, Len("\") + 1)
    Else
        Set flr = app.ActiveExplorer.CurrentFolder
    End If
    While szPath <> ""
        i = InStr(szPath, "\")
        If i Then
            szDir = Left(szPath, i - 1)
            szPath = Mid(szPath, i + Len("\"))
        Else
            szDir = szPath
            szPath = ""
        End If
        If IsNothing(flr) Then
            Set ns = app.GetNamespace("MAPI")
            Set flr = ns.Folders(szDir)
        Else
            Set flr = flr.Folders(szDir)
        End If
    Wend
    Set OpenMAPIFolder = flr
End Function

Function IsNothing(Obj)
  If TypeName(Obj) = "Nothing" Then
    IsNothing = True
  Else
    IsNothing = False
  End If
End Function
'Script ends here