Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Outlook Macro

Posted on 2014-08-01
3
Medium Priority
?
490 Views
Last Modified: 2014-09-02
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.
0
Comment
Question by:Corey Gashlin
2 Comments
 
LVL 20

Accepted Solution

by:
ltlbearand3 earned 2000 total points
ID: 40235621
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
 
LVL 50

Expert Comment

by:Martin Liss
ID: 40297990
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Mailbox Corruption is a nightmare every Exchange DBA wishes he never has. Recovering from it can be super-hectic if not entirely futile. And though techniques like the New-MailboxRepairRequest cmdlet have been designed to help with fixing minor corr…
I came across an unsolved Outlook issue and here is my solution.
CodeTwo Sync for iCloud (http://www.codetwo.com/sync-for-icloud?sts=6554) automatically synchronizes your Outlook 2016, 2013, 2010 or 2007 folders with iCloud folders available via iCloud Control Panel. This lets you automatically sync them with…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…
Suggested Courses
Course of the Month21 days, 6 hours left to enroll

810 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question