outlook在新建邮件时如何获取当前的邮箱地址

烟雨记忆

本意是想实现，在发邮件时自动密送给自己，现在密送功能实现了，但是密送的邮箱是代码中固定的，现在想通过代码实现，获取当前账户的邮箱地址，这样就可以实现，无论outlook中几个账户，在发邮件时，都是可以自动密送给当前邮箱，求帮忙，现在不知道如何可以获得当前账号的邮箱地址

cocojyg

显示所有账户名称 和 对应的序号
Dim l As Integer
For l = 1 To OutApp.Session.Accounts.Count
MsgBox OutApp.Session.Accounts.Item(l) & " : This is account number " & l
Next l

1为默认邮件账户, 如果需其他账户,请修改1为对应的序号
.BCC = OutApp.Session.Accounts.Item(1)

烟雨记忆

谢谢你，但是这还是不能全自动的实现“在新建邮件时自动密送给当前账户”

cocojyg

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim OutApp As New Outlook.Application
Set OutApp = New Outlook.Application
'Dim l As Integer
'For l = 1 To OutApp.Session.Accounts.Count
'MsgBox OutApp.Session.Accounts.Item(l) & " : This is account number " & l
'Next l
    strBcc = OutApp.Session.Accounts.Item(1)
    MsgBox "邮件秘密抄送 :" & OutApp.Session.Accounts.Item(1)
    Set objRecip = Item.Recipients.Add(strBcc)
     objRecip.Type = olBCC
     If Not objRecip.Resolve Then
         strMsg = "不能解析密件抄送人邮件地址， " & _
                  "请确认是否仍然发送邮件？"
         res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                 "不能解析密件抄送人邮件地址")
         If res = vbNo Then
             Cancel = True
         End If
     End If
     Set objRecip = Nothing
End Sub
'参考 http://club.excelhome.net/forum.php/thread-497946-2-1.html  12楼
'Win7+2010测试成功

狂人风范

@cocojyg
如何在excel中提取outlook查看邮件的发件人地址，
求代码！