首先,我要声明的是,我已经研究过这个问题,并尝试了这里和其他地方提出的大量解决方案。如果这个问题之前已经得到解答,我深表歉意,我发誓我已经研究过并尝试过,但我的主要问题是我的 VB 技能与黑猩猩一样,我认为解决方案至少需要 Bonobo 级别的 VB 技能。
我正在尝试在 Outlook 中创建一个 VB 脚本,该脚本将遍历我的默认联系人文件夹并查看每个联系人的 .Email1Address,并将“EX”Email1AddressType 转换为字符串并将其写入 .User1 属性。
目标是当我从 GAL 添加联系人时,能够始终从 Outlook 导出存储为“EX”的联系人的 SMTP 地址。
我认为我在这里偏离了目标,任何帮助都将不胜感激。非常感谢:
Public Sub User1SMTPAddress()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objContact As Outlook.ContactItem
Dim objItems As Outlook.Items
Dim objContactsFolder As Outlook.MAPIFolder
Dim oExUser As Outlook.ExchangeUser
Dim obj As Object
Dim SMTPEmailAddress As String
Dim MyContactID As String
Dim oPA As Outlook.PropertyAccessor
On Error Resume Next
Set objOL = CreateObject("Outlook.Application")
Set objNS = objOL.GetNamespace("MAPI")
Set objContactsFolder = objNS.GetDefaultFolder(olFolderContacts)
Set objItems = objContactsFolder.Items
For Each obj In objItems
If obj.Class = olContact Then
Set objContact = obj
With objContact
Set oPA = objContact.PropertyAccessor
MyContactID = oPA.BinaryToString_(oPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0C190102"))
Set oSender = Globals.objNS.GetAddressEntryFromID(MyContactID)
oExUser = oSender.GetExchangeUser()
SMTPEmailAddress = oExUser.PrimarySmtpAddress
.User1 = SMTPEmailAddress
.Save
End With
End If
Err.Clear
Next
Set objOL = Nothing
Set objNS = Nothing
Set obj = Nothing
Set objContact = Nothing
Set objItems = Nothing
Set objContactsFolder = Nothing
End Sub