我是使用VBA和Macros的新手,我想知道是否有办法在Excel中添加“检查名称”功能(类似于Outlook中的功能)。我正在处理的表单的一部分要求我输入员工的姓名,我希望能够单击一个按钮以确保我已正确拼写他们的名字,并且他们在我们的电子邮件系统中。任何有关正确方向的帮助或指示都将不胜感激!
答案 0 :(得分:2)
这里有几个答案:
编辑:在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