如何使用VBA获取当前的Office Windows帐户电子邮件？

Question

如何使用VBA代码获取当前的Office Windows帐户电子邮件？ 我不是指用户在Windows中登录的帐户，我的意思是在办公室授权的帐户

见图片

Answer 1

我不相信你可以访问它。您最好的选择是将Access连接到Outlook并尝试从那里访问它。

例如，您设置对Outlook对象库的引用，然后： -

Dim olook As Outlook.Application
Dim EAddress As String

Set olook = GetObject(, "Outlook.Application")
Set olook = CreateObject("Outlook.Application")


EAddress = olook.Session.CurrentUser.Address

Answer 2

我有一个类似的解决方案，可以调用Outlook，我正在使用Excel，并且找到了一种解决方法，我只在Accounts集合中找到一个地址，但是有一个后缀匹配项来尝试捕获@我正在寻找的company.com

Dim NameSpace As Object
Dim strEmailAddress As String
Set NameSpace = CreateObject("Outlook.Application").GetNameSpace("MAPI")
strEmailAddress = ""

For Each Account In NameSpace.Accounts
    If LCase(Split(Account.SMtpAddress, "@")(1)) = "contoso.com" Then
        strEmailAddress = Account.SMtpAddress
    Else
        strEmailAddress = "Unknown"
    End If

    ' If you want to see more values, uncomment these lines
    'Debug.Print Account.DisplayName
    'Debug.Print Account.UserName
    'Debug.Print Account.SMtpAddress
    'Debug.Print Account.AccountType
    'Debug.Print Account.CurrentUser
Next

Answer 3

由于安全原因，Outlook中断了VBA执行（从宏访问Outlook对象）。

快照 Outlook Security

因此仅在不打开对象的情况下获取eMailID以及在无法使用Outlook /帐户的情况下处理错误的情况，以下代码可以在您的情况下工作

VBA代码

Sub Email_Address()
    Dim MAPI As Object

    Status = "unknown"

    On Error GoTo return_value
    Set MAPI = CreateObject("Outlook.Application").GetNameSpace("MAPI")

    i = 1
    Do While True
        Debug.Print MAPI.Accounts.Item(i)
        i = i + 1
    Loop

return_value:
    If i > 1 Then: Status = "done..."
    Debug.Print Status
End Sub