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?
 
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
 
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.