使用outlook发送邮件的时候,会由于某种原因发错人等等,在网上收了一些资料成一个宏,用于发送邮件之前的确认信息。
步骤如下:
1, 打开outlook,工具—》宏—》visual basic 编辑器
2, 即可打开编辑器,双击thisoutlooksession 打开一个代码编辑画面将如下代码copy进去即可。
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objRecip As Recipient
Dim objContact As ContactItem
Dim strExternal As String
If Item.MessageClass Like "IPM.TaskRequest*" Then
Set Item = Item.GetAssociatedTask(False)
End If
strExternal = ""
For Each objRecip In Item.Recipients
Set objContact = FindContactByAddress(objRecip.Address)
If objContact Is Nothing Then
If LCase(objRecip.Address) Like "/o=*" Then
strExternal = strExternal & "内部发送" & objRecip.Name & vbCr
Else
strExternal = strExternal & "外部发送" & objRecip.Name & vbCr
End If
End If
Next
If strExternal <> "" Then
MSGText = "主题:「" & Item.Subject & "」" & vbCr & "要向下面的地址发送邮件,确定吗?" & _
vbLf & "收信人地址:" & vbCr & strExternal
If MsgBox(MSGText, vbYesNo, "发送确认") = vbNo Then
Cancel = True
End If
End If
End Sub
Private Function FindContactByAddress(strAddress As String)
Dim objContacts
Dim objContact
Set objContacts = Application.Session.GetDefaultFolder(olFolderContacts)
Set objContact = objContacts.Items.Find("[Email1Address] = '" & strAddress _
& "' or [Email2Address] = '" & strAddress _
& "' or [Email3Address] = '" & strAddress & "'")
Set FindContactByAddress = objContact
End Function