Outlook 2010-从个人邮件发送电子邮件之前弹出警告窗口

时间:2018-06-26 04:54:55

标签: vba outlook

我在工作时使用的是Outlook 2010,并将我的个人邮件ID作为主要帐户进行了链接,其余的组共享邮件ID在服务器级别进行了链接。

因此,当我从网上论坛发送新电子邮件时,默认情况下会选择个人邮件ID,用户必须每次更改它。

当选择From作为我的个人ID时,我使用下面的宏提供警告弹出窗口,但是即使在From中选择了共享邮件ID,该宏也会发出警告。

如果From不是主要ID或个人ID,或者在基于组共享邮件创建新电子邮件时是否有宏可以自动选择From,如何防止此警告ID是?


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If InStr(LCase(Item.SendUsingAccount), "sara@example.com.") Then
    Prompt$ = "You sending this from sara@example.com. Are you sure you want to send it?"
    If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
        Cancel = True
    End If
End If
End Sub 

1 个答案:

答案 0 :(得分:0)

从对应于SentOnBehalfOfName属性。在发送邮件之前,该字段为空,除非您在发送之前在代码中进行了设置。在这里没有用,因为您要验证是否忘记设置它。

Private Sub SetFrom()

Dim curritem As mailItem
Dim uPrompt As String

Set curritem = CreateItem(olMailItem)

curritem.Display

uPrompt = "This mail has not been sent." & vbCr & vbCr
uPrompt = uPrompt & "The SentOnBehalfOfName (From) property is empty unless set in the code." & vbCr & vbCr
uPrompt = uPrompt & "See between the quotes." & vbCr & vbCr
MsgBox uPrompt & Chr(34) & ActiveInspector.currentItem.SentOnBehalfOfName & Chr(34)

' Note: The From in the user interface does not populate the property."

curritem.SentOnBehalfOfName = "sharedmailbox@example.com"

' For demonstration purposes. Not necessary to display in real code.
curritem.Close olSave
curritem.Display

MsgBox "SentOnBehalfOfName set in the code." & vbCr & vbCr & _
    "The SentOnBehalfOfName (From) is set to: " & curritem.SentOnBehalfOfName

ExitRoutine:
    Set curritem = Nothing

End Sub

您的验证SendUsingAccount的尝试可能失败,因为一个帐户有多个邮箱,而您想要多个帐户。

Sub Account_name()

Dim olAcct As account
Dim countAcc As Long
Dim i As Long

countAcc = Session.Accounts.count

For i = 1 To countAcc
    Debug.Print "Account.....: " & i
    Debug.Print " DisplayName: " & Session.Accounts.Item(i).DisplayName
    Debug.Print " UserName   : " & Session.Accounts.Item(i).userName
    Debug.Print
Next

End Sub

如果您只有一个帐户,请查看Add an email account to Outlook以添加具有所需权限的帐户。