সক্রিয় ডিরেক্টরি থেকে তথ্য টানুন

Question

আমার কাছে দুইটি ডেটা রয়েছে যা কখনও কখনও সম্পূর্ণ না হওয়া পর্যন্ত রেফারেন্স ক্রস করতে হবে। আমি এইচআর থেকে একটি ফাইল পেয়েছি যা কর্মীদের জন্য জনসংখ্যাতাত্ত্বিক তথ্য অন্তর্ভুক্ত করে (তাদের ইমেল ঠিকানা সহ)। আমি অ্যাক্টিভ ডিরেক্টরি থেকে টানা হচ্ছে আউটলুক পরিচিতি অ্যাক্সেস আছে। আমি কখনও কখনও তাদের নেটওয়ার্কের "ওরফে" খুঁজে পেতে একজন ব্যক্তির ইমেল ঠিকানা ব্যবহার করার প্রয়োজন আছে এবং, এই মুহুর্তে, আমি পৃথক ভিত্তিতে মানুষের সন্ধান করছি।

যাইহোক, এই তথ্যটি রেফারেন্স আমার প্রয়োজন বাড়ছে এবং আমি মাঝে মাঝে শত শত মানুষ যারা আমি জন্য একটি উপনাম দখল প্রয়োজন আছে।

অ্যাক্টিভ ডিরেক্টরি থেকে এই তথ্যটি ডাউনলোড / জিজ্ঞাসা করার উপায় আছে যাতে আমি Excel এ এই ডেটাতে যোগ দিতে পারি?

সম্পাদনা করুন: আমার পাওয়ারশেল স্ক্রিপ্ট চালানোর ক্ষমতা নেই।

Comments

আমি একটি তৃতীয় পক্ষ অ্যাড-ইন ব্যবহার করে একটি সমাধান খুঁজে পেয়েছি ( extendoffice.com/documents/outlook/... ), আমি সহজ উপায় আছে নিশ্চিত নই।

— Máté Juhász

Answer 1

আমি স্ট্যাক ওভারফ্লো উপর একটি উপযুক্ত সমাধান খুঁজে পেতে সক্ষম ছিল এখানে. আমি কম্পাইল করা তথ্য tweaked এবং এক্সেল আমার চূড়ান্ত সাব হিসাবে এই সঙ্গে শেষ পর্যন্ত।

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