CODEWITHSUNDEEP
vbaemailpermissionsoutlook
thomas hedley
thomas hedley

Reputation: 13

vba script in outlook not working for internal emails

so I'm trying to get a script to run on every sent item to a specific internal mailbox and I found this code online;

Public Sub application_ItemSend(ByVal Item As Object, Cancel As Boolean)

'check for address
If InStr(LCase(Item.To), "[email protected]") Then
      'ask if we've added the date
      prompt$ = "You're sending this to " & Item.To & ". have you added the due date?"
       If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
         Cancel = True
       End If
  End If

End Sub

so the script works but solely for external emails (I've been using my personal email to test) but not for the internal mailbox, when you send it to the internal mailbox the script doesn't even run.

this seems more like a persmissions issue than anything else but I wanted to see if any of you guys could possibly chip in. I wasn't sure if this was more of a common problem than it would appear but I have been unable to find anything online and there's only so much head scratching I can do in a night!

hopefully you can help. :)

thanks,

Tom.

Upvotes: 1

Views: 432

Answers (2)

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66225

To property is just the display name of all To recipients concatenated using ";". It may or may not contain the SMTP address.

Loop through all recipients in the Recipients collection, read the Recipient.Type property to make sure it is olTo. Retrieve the Recipient.AddressEntry property (returns AddressEntry object). If AddressEntry.Type = "SMTP", use AddressEntry.Address. If AddressEntry.Type = "EX", use AddressEntry.GetExchangeUser.PrimarySmtpAddress.

Also keep in mind that the Cancel parameter must be declared as ByRef.

dim addrType
dim addr
dim recip    
for each recip in item.Recipients
 if recip.Type = olTo Then
    addrType = recip.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3002001F")
    if addrType = "EX" Then
      addr = recip.AddressEntry.GetExchangeUser.PrimarySmtpAddress
    Else
      addr = recip.Address
    End If
    if LCase(addr) = "[email protected]" Then
      MsgBox "got it"
      Exit for
    End If
  End If
next

Upvotes: 2

user5412293
user5412293

Reputation:

You were using the incorrect function for this "Instr" will return the position of one string inside the other. If you want to compare two strings the correct function is "StrComp"

Option Explicit

Public Sub application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Const strRELEVANT_EMAIL_ADDRESS As String = "[email protected]"
    Dim strPromp As String

    strPromp = "You're sending this to " & Item.To & ". have you added the due date?"

    'check for address
    If StrComp(LCase$(Item.To), strRELEVANT_EMAIL_ADDRESS) = 0 Then

        'ask if we've added the date
        If MsgBox(strPromp, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
            Cancel = True
        End If
    End If

End Sub

Hope this solves the problem.

Thanks

Upvotes: 0

Related Questions