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), "relevant.email@outlook.com") 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.

回答1:

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) = "relevant.email@outlook.com" Then
      MsgBox "got it"
      Exit for
    End If
  End If
next

回答2:

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 = "relevant.email@outlook.com"
    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

来源：https://stackoverflow.com/questions/33336175/vba-script-in-outlook-not-working-for-internal-emails

标签

vba

permissions

outlook