选择VBA脚本的帐户

时间:2016-12-24 11:58:23

标签: vba outlook-vba

我编写了代码来限制To,CC和BCC字段的地址数。

唯一的问题是代码会影响所有帐户,而不会影响我选择的特定帐户。

e.g: user1@xyz.com
     user2@xyz.com

我希望此代码仅适用于“user1@xyz.com”帐户,而不适用于“user2@xyz.com”帐户。但代码在整个Outlook会话中运行。有没有选择在代码中选择帐户?

Private Sub Application_ItemSend(ByVal Element As Object, Cancel As Boolean)
    Dim aaa() As String
    Dim bbb() As String
    Dim ccc() As String
    aaa = Split(Element.To, ";")
    bbb = Split(Element.CC, ";")
    ccc = Split(Element.BCC, ";")
    If (UBound(aaa) + 1) + (UBound(bbb) + 1) + (UBound(ccc) + 1) > 10 Then
        MsgBox ("You have added too many recipients! Please contact your Administrator."), vbExclamation, "Authorization required!"
        Cancel = True
    End If
End Sub

2 个答案:

答案 0 :(得分:0)

我已经写了很多VBA,但没有写过Outlook,所以我在这里猜一点。如何在拆分任何东西之前插入它:

If LCase(Environ("Username") & "@" & Environ("Userdnsdomain")) <> "user1@xyz.com" Then Exit Sub

答案 1 :(得分:0)

您可以找到适用的帐户

Private Sub Application_ItemSend(ByVal Element As Object, Cancel As Boolean)

Dim oAccount As account

For Each oAccount In Session.Accounts

    If oAccount = "user1@xyz.com" Then

        Dim aaa() As String
        Dim bbb() As String
        Dim ccc() As String
        aaa = Split(Element.To, ";")
        bbb = Split(Element.CC, ";")
        ccc = Split(Element.BCC, ";")

        If (UBound(aaa) + 1) + (UBound(bbb) + 1) + (UBound(ccc) + 1) > 1 Then
            MsgBox ("You have added too many recipients! Please contact your Administrator."), vbExclamation, "Authorization required!"
            Cancel = True
        End If

    End If
Next

ExitRoutine:
    Set oAccount = Nothing

End Sub