सक्रिय निर्देशिका से जानकारी खींचो

Question

मेरे पास डेटा के दो सेट हैं जिन्हें मुझे कभी-कभी संदर्भ को पार करने की आवश्यकता होती है क्योंकि न तो पूर्ण होते हैं। मुझे HR से एक फ़ाइल मिलती है जिसमें कर्मचारियों के लिए जनसांख्यिकीय जानकारी (उनके ईमेल पते सहित) शामिल है। सक्रिय निर्देशिका से आउटलुक संपर्कों तक मेरी भी पहुंच है। मुझे कभी-कभी अपने नेटवर्क "उर्फ" को खोजने के लिए किसी व्यक्ति के ईमेल पते का उपयोग करने की आवश्यकता होती है और, इस बिंदु तक, मैं लोगों को व्यक्तिगत आधार पर देख रहा हूं।

हालांकि, इस डेटा को संदर्भित करने की मेरी आवश्यकता बढ़ रही है और मेरे पास कभी-कभी सैकड़ों लोग हैं जिनके लिए मुझे एक उपनाम लेने की आवश्यकता है।

क्या सक्रिय निर्देशिका से इस जानकारी को डाउनलोड / क्वेरी करने का कोई तरीका है ताकि मैं इस डेटा को एक्सेल में शामिल कर सकूं?

संपादित करें: मेरे पास पॉवरशेल स्क्रिप्ट चलाने की क्षमता नहीं है।

Comments

मैंने तीसरे पक्ष के ऐड-इन का उपयोग करके एक समाधान पाया है ( extendoffice.com/documents/outlook/... ), मुझे यकीन नहीं है कि आसान तरीका है।

— Máté Juhász

Answer 1

मैं स्टैक ओवरफ्लो पर एक उपयुक्त समाधान खोजने में सक्षम था यहाँ। मैंने डेटा को संकलित किया और एक्सेल में मेरे अंतिम उप के रूप में इसे संकलित किया।

Sub GALExport()

Dim appOL As Object
Dim oGAL As Object
Dim oContact As Object
Dim oUser As Object
Dim arrUsers(1 To 65000, 1 To 5) As String
Dim UserIndex As Long
Dim i As Long

Set appOL = CreateObject("Outlook.Application")
Set oGAL = appOL.GetNameSpace("MAPI").AddressLists("Global Address List").AddressEntries

For i = 1 To oGAL.Count
    Set oContact = oGAL.Item(i)
    If oContact.AddressEntryUserType = 0 Then
        Set oUser = oContact.GetExchangeUser
        If Len(oUser.lastname) > 0 Then
            UserIndex = UserIndex + 1
            arrUsers(UserIndex, 1) = oUser.Name
            arrUsers(UserIndex, 2) = oUser.PrimarySMTPAddress
            arrUsers(UserIndex, 3) = oUser.Alias
            arrUsers(UserIndex, 4) = oUser.JobTitle
            arrUsers(UserIndex, 5) = oUser.Department
        End If
    End If
Next i

appOL.Quit

Range("A1").Value = "Name"
Range("B1").Value = "Email Address"
Range("C1").Value = "Network Alias"
Range("D1").Value = "Job Title"
Range("E1").Value = "Department"

If UserIndex > 0 Then
    Range("A2").Resize(UserIndex, UBound(arrUsers, 2)).Value = arrUsers
End If

Set appOL = Nothing
Set oGAL = Nothing
Set oContact = Nothing
Set oUser = Nothing
Erase arrUsers

End Sub