Writing VBA Help Needed

[Sondra]

I want to set up a time sensitive Rule for incoming documents. I found this
in the help on MS Website, but I don't have a clue how to modify it for
myself.

Please help....

I need to have it send emails to (e-mail address removed) between 6 pm and 9 am Monday
through Friday and from Friday nite at 6 pm to 9am Monday morning (All
weekend mail to the email addres identified above). All other times the
email should go to (e-mail address removed). I am not familiar with VBA lanquage so I
don't know where to really start on this. Any help would be great.

***************************8

Public WithEvents myOlItems As Outlook.Items


Public Sub Application_Startup()

' Reference the items in the Inbox. Because myOlItems is declared
' "WithEvents" the ItemAdd event will fire below.
Set myOlItems = Outlook.Session.GetDefaultFolder(olFolderInbox).Items

End Sub


Private Sub myOlItems_ItemAdd(ByVal Item As Object)

' If it's currently not between 9:00 A.M. and 5:00 P.M.
If Time() < #9:00:00 AM# Or Time() > #5:00:00 PM# Then

' Check to make sure it is an Outlook mail message, otherwise
' subsequent code will probably fail depending on what type
' of item it is.
If TypeName(Item) = "MailItem" Then

' Forward the item just received
Set myForward = Item.Forward

' Address the message
myForward.Recipients.Add "(e-mail address removed)"

' Send it
myForward.Send

End If

End If

End Sub

 

[JP]

Based on your description and the sample code you provided, it sounds
like this is what you need.

Public WithEvents myOlItems As Outlook.Items

Public Sub Application_Startup()
' Reference the items in the Inbox. Because myOlItems is declared
' "WithEvents" the ItemAdd event will fire below.
Set myOlItems = Outlook.Session.GetDefaultFolder
(olFolderInbox).Items
End Sub

Private Sub myOlItems_ItemAdd(ByVal Item As Object)

Dim recipient As String
Const firstRecip As String = "(e-mail address removed)"
Const secondRecip As String = "(e-mail address removed)"

' no point in checking the time if it isn't an email!
If TypeName(Item) <> "MailItem" Then Exit Sub

' If it's currently not between 9:00 A.M. and 5:00 P.M.
If (Time() < #9:00:00 AM#) Or (Time() > #6:00:00 PM#) Then

' use first recipient
recipient = firstRecip

Else

' check if it's a weekend, but regular hours
' Saturday and Sunday also fwd to after hours recip
Select Case Weekday(Now, vbMonday)
Case Is > 6
recipient = firstRecip
Case Else
recipient = secondRecip
End Select

Else ' it's during the day
recipient = secondRecip
End If

' Forward the item just received
Set myForward = Item.Forward
' Address the message
myForward.Recipients.Add recipient
' Send it
myForward.Send

End Sub


Just paste it into the ThisOutlookSession module in your Outlook
VBIDE. Write back if you need to know how to do that.

And I have to ask, if ALL emails during business hours need to be send
to a different email address, why not just tell the senders to send it
THERE instead? Then you wouldn't need this complicated routing code.

--JP