在Excel中創建「檢查姓名」按鈕

Question

我是使用VBA和宏的新手，想知道是否有方法在Excel中添加「檢查姓名」功能（類似於Outlook中的功能）。我正在處理的部分表單需要我輸入員工姓名，我希望能夠點擊一個按鈕以確保我的拼寫正確，並且他們在我們的電子郵件系統中。任何幫助或指針在正確的方向將不勝感激！

Answer 1

一對夫婦的答案在這裏：

編輯：創建Excel 2010中（不知道是否會在2003年的工作）。

如果名稱可以在Outlook中解析，則第一個將返回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 

第二要解決的名稱，並返回的電子郵件地址：

'---------------------------------------------------------------------------------- 
' 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