在 Excel 中创建一个 "Check Names" 按钮

Question

我刚开始使用 VBA 和宏，想知道是否有办法在 Excel 中添加 "check names" 函数（类似于 Outlook 中的函数）。我正在处理的部分表格要求我输入员工姓名，我希望能够单击一个按钮以确保我正确拼写了他们的姓名并且他们在我们的电子邮件系统中。任何正确方向的帮助或指示将不胜感激！

Answer 1

这里有几个答案：

编辑：创建于 Excel 2010 年（不知道它是否会在 2003 年运行）。

如果名称可以在 Outlook 中解析，第一个 return 为 TRUE 或 FALSE。

'----------------------------------------------------------------------------------
' Procedure : ResolveDisplayNameToSMTP
' Author    : Sue Mosher - updated by D.Bartrup-Cook to work in Excel late binding.
'-----------------------------------------------------------------------------------
Public Function ResolveDisplayName(sFromName) As Boolean

    Dim OLApp As Object 'Outlook.Application
    Dim oRecip As Object 'Outlook.Recipient
    Dim oEU As Object 'Outlook.ExchangeUser
    Dim oEDL As Object 'Outlook.ExchangeDistributionList

    Set OLApp = CreateObject("Outlook.Application")
    Set oRecip = OLApp.Session.CreateRecipient(sFromName)
    oRecip.Resolve
    If oRecip.Resolved Then
        ResolveDisplayName = True
    Else
        ResolveDisplayName = False
    End If

End Function

第二个将解析名称和 return 电子邮件地址：

'----------------------------------------------------------------------------------
' Procedure : ResolveDisplayNameToSMTP
' Author    : Sue Mosher - updated by D.Bartrup-Cook to work in Excel late binding.
'-----------------------------------------------------------------------------------
Public Function ResolveDisplayNameToSMTP(sFromName) As String
    Dim OLApp As Object 'Outlook.Application
    Dim oRecip As Object 'Outlook.Recipient
    Dim oEU As Object 'Outlook.ExchangeUser
    Dim oEDL As Object 'Outlook.ExchangeDistributionList

    Set OLApp = CreateObject("Outlook.Application")
    Set oRecip = OLApp.Session.CreateRecipient(sFromName)
    oRecip.Resolve
    If oRecip.Resolved Then
        Select Case oRecip.AddressEntry.AddressEntryUserType
            Case 0, 5 'olExchangeUserAddressEntry & olExchangeRemoteUserAddressEntry
                Set oEU = oRecip.AddressEntry.GetExchangeUser
                If Not (oEU Is Nothing) Then
                    ResolveDisplayNameToSMTP = oEU.PrimarySmtpAddress
                End If
            Case 10, 30 'olOutlookContactAddressEntry & 'olSmtpAddressEntry
                    ResolveDisplayNameToSMTP = oRecip.AddressEntry.Address
        End Select
    End If
End Function

下面是展示如何使用这两个功能的测试程序：

Sub Test()

    MsgBox ResolveDisplayName("Marty Moesta")
    MsgBox ResolveDisplayNameToSMTP("Marty Moesta")

End Sub

在 Excel 中创建一个 "Check Names" 按钮

Creating a "Check Names" button in Excel

excel

outlook

vba