在Excel中创build一个“检查姓名”button

我是使用VBA和macros的新手，想知道是否有方法在Excel中添加“检查名称”function（类似于Outlook中的function）。 我正在处理的部分表单需要我input员工的姓名，我希望能够点击一个button来确保我的拼写正确，并且在我们的电子邮件系统中。 任何帮助或指针在正确的方向将不胜感激！

Answer 1

这里有几个答案：

编辑：在Excel 2010中创build（不知道它是否会在2003年工作）。

如果名称可以在Outlook中parsing，则第一个将返回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 

第二个将parsing名称并返回电子邮件地址：

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

这是一个testing过程，展示了如何使用这两个函数：

 Sub Test() MsgBox ResolveDisplayName("Marty Moesta") MsgBox ResolveDisplayNameToSMTP("Marty Moesta") End Sub