Outlook Macro

Hello All,

I am tryign to write a macro for outlook on send out of mail that checks ot see if th recipient is an internal or external. If it is an internal I want it to put it as a delayed delivery and not send until 4PM no matter what day. I have it kinda working just canceling the message if internal.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
 Dim recips As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim pa As Outlook.PropertyAccessor

    Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    Set recips = Item.Recipients
    For Each recip In recips
        Set pa = recip.PropertyAccessor
        If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@mycompany.net") > 0 Then
            If MsgBox("Send mail to internal address?", vbYesNo + vbQuestion + 

vbMsgBoxSetForeground, "MY COMPANY E-Mail Policy Notice") = vbNo Then
             Cancel = True
             Call CheckSendTime
             
            
          
             
              
            Else
                Exit Sub
            End If
        End If
    Next
     
End Sub

Open in new window


I tried adding in some subs but it failed saying email already in progress.
Corey GashlinCTOAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ltlbearand3Commented:
Not sure what version of Outlook you are using, but try this adjustment to your code.  It works for me.  It will automatically add a delayed delivery time if it is before 4 p.m.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    If Item.Class = Outlook.olMail Then
        Dim recips As Outlook.Recipients
        Dim recip As Outlook.Recipient
        Dim pa As Outlook.PropertyAccessor

        Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
        Set recips = Item.Recipients
        For Each recip In recips
            Set pa = recip.PropertyAccessor
            If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@outlook.com") > 0 Then
                ' Check if DeferredDeliveryTime is default
                If Item.DeferredDeliveryTime = #1/1/4501# Then
                    Item.DeferredDeliveryTime = Date + #4:00:00 PM#
                ElseIf Hour(Item.DeferredDeliveryTime) < 16 Then
                    ' Time is earlier than 4 PM
                    Item.DeferredDeliveryTime = DateValue(Item.DeferredDeliveryTime) + #4:00:00 PM#
                End With
            End If
        Next
    End If
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Martin LissOlder than dirtCommented:
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.