Outlook VBS untuk Menambahkan alamat SMTP dari EX (x.500) ke Properti ContactItem.User1


3

Pertama, saya ingin menyatakan bahwa saya telah meneliti yang ini dan telah mencoba banyak solusi yang diajukan di sini dan di tempat lain. Saya minta maaf jika ini telah dijawab sebelumnya, saya bersumpah saya telah melihat dan mencoba, tetapi masalah utama yang saya miliki adalah bahwa saya memiliki keterampilan VB simpanse, dan saya pikir solusinya memerlukan setidaknya tingkat keterampilan VB Bonobo.

Saya mencoba membuat skrip VB di Outlook yang akan melalui folder kontak default saya dan melihat masing-masing kontak .Email1Address dan mengonversi "EX" Email1AddressType ke string dan menulisnya ke properti .User1.

Tujuannya adalah untuk selalu dapat mengekspor dari Outlook alamat SMTP dari kontak saya yang disimpan sebagai "EX" ketika saya menambahkannya dari GAL.

Saya pikir saya sedang menunggu target di sini, dan bantuan apa pun akan dihargai. Terima kasih banyak:

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
Dengan menggunakan situs kami, Anda mengakui telah membaca dan memahami Kebijakan Cookie dan Kebijakan Privasi kami.
Licensed under cc by-sa 3.0 with attribution required.