Macro not working for fetching data from Active Directory

[Negi1984]

Hi All,

I was using below code writing by my old team member, which is not working in my new system. where as it is working in my old machine.
When I trouble shoot with some other team members it was told to me to add "ADODB.Connection" line in below code.

Can anybody help me out how to add the "ADODB.Connection" code in below given code ?

Also When I checked macro line by line items by pressing F8 key its is showing blank in "idapstr" line where as in old machine when using same macro its working fine.

ldapstr = "LDAP://CN=" & signum & ",OU=CA,OU=User,OU=P001,OU=ID,OU=Data,DC=XXXXXXXX,DC=se"
Set x = GetObject(ldapstr)

Public Sub UpdateResourceInfoNew()
Application.Calculation = xlCalculationManual
Dim auxDoc As New MSHTML.HTMLDocument, HTMLDoc As MSHTML.HTMLDocument
Dim rw As IHTMLTableRow
Dim table1 As IHTMLTable
Dim x As IADs
Dim lo As Excel.ListObject
Dim lr As Excel.ListRow
Dim rng As Range
Dim col As Column
Dim signum, name, ldapstr, relation As String
    Dim urlText As Variant
    Dim keyVal As Variant
    Dim wb As Workbook
    Dim ws As Worksheet
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("ASSIGNMENTS")
    
    Dim responseDict As Dictionary
On Error Resume Next

Dim answer As Integer
answer = MsgBox("Did you updated the Authorization Key in sheet ?", vbQuestion + vbYesNo)
If answer = vbYes Then

Set lo = ActiveWorkbook.Worksheets("ASSIGNMENTS").ListObjects("ASSIGNMENTS")

For Each lr In lo.ListRows
Set rng = lr.Range
signum = UCase(rng.Cells.Columns(lo.ListColumns("SIGNUM").Index).Value)
name = rng.Cells.Columns(lo.ListColumns("NAME").Index).Value
updateFlag = rng.Cells.Columns(lo.ListColumns("UPDATE_RES_INFO").Index).Value

If signum <> "" And updateFlag = 1 Then
ldapstr = "LDAP://CN=" & signum & ",OU=CA,OU=User,OU=P001,OU=ID,OU=Data,DC=XXXXXXXX,DC=se"
Set x = GetObject(ldapstr)
x.GetInfoEx Array("CN", "displayName", "givenName", , "email", "sn", "homePhone", "title", "department", "company", "l", "Manager", "country"), 0
auxCN = UCase(x.Get("CN"))
If (auxCN = signum) Then
rng.Cells.Columns(lo.ListColumns("SIGNUM").Index).Value = UCase(signum)
rng.Cells.Columns(lo.ListColumns("NAME").Index).Value = Application.WorksheetFunction.Proper(x.Get("displayName"))
rng.Cells.Columns(lo.ListColumns("RELATION").Index).Value = Application.WorksheetFunction.Proper(x.Get("homePhone"))
rng.Cells.Columns(lo.ListColumns("TITLE").Index).Value = x.Get("title")
rng.Cells.Columns(lo.ListColumns("DEPARTMENT").Index).Value = UCase(x.Get("department"))
rng.Cells.Columns(lo.ListColumns("COMPANY").Index).Value = UCase(x.Get("company"))
rng.Cells.Columns(lo.ListColumns("COUNTRY").Index).Value = UCase(x.Get("country"))
rng.Cells.Columns(lo.ListColumns("LAST NAME").Index).Value = Application.WorksheetFunction.Proper(x.Get("sn"))
rng.Cells.Columns(lo.ListColumns("FIRST NAME").Index).Value = Application.WorksheetFunction.Proper(x.Get("givenName"))
rng.Cells.Columns(lo.ListColumns("E-MAIL").Index).Value = x.Get("mail")
rng.Cells.Columns(lo.ListColumns("HOME BASE").Index).Value = UCase(x.Get("l"))
rng.Cells.Columns(lo.ListColumns("UPDATE_RES_INFO").Index).Value = 2


    Set responseDict = New Dictionary
    url_prefix = "XXXXXXX"
    
    
    
    url_suffix = signum_rng
        
    Application.DisplayAlerts = False
    
    On Error Resume Next
            
            
           Dim returnVal As String
    
    Dim httpObject As Object, item As Object
    Set httpObject = CreateObject("MSXML2.XMLHTTP")
            
            Url = url_prefix & Trim(signum)
            
                sAuthorization = Worksheets("Authentication key").Range("G4").Value
            
            
    httpObject.Open "GET", Url, False
    httpObject.setRequestHeader "Authorization", sAuthorization & EncodeBase64
    httpObject.Send
    sGetResult = httpObject.responseText
                        
            
            With CreateObject("MSXML2.XMLHTTP")
                .Open "GET", Url, False
                .Send
                urlText = Split(Replace(Replace(Replace(Replace(.responseText, "{", ""), "[", ""), "}", ""), "]", ""), ",""")
            End With
            
            responseDict.RemoveAll
            
           For i = 0 To UBound(urlText)
                urlText(i) = Replace(urlText(i), Chr(34), "")
                keyVal = Split(urlText(i), ":")
                responseDict.Add keyVal(0), keyVal(1)
            Next i
            If Split(urlText(34), ":")(1) <> "null" Or Len(Split(urlText(34), ":")(1)) <> 0 Then
                rng.Cells.Columns(lo.ListColumns("PERSONNEL NUMBER").Index).Value = Split(urlText(34), ":")(1)
            End If
            
            
           If Split(urlText(11), ":")(1) <> "null" Or Len(Split(urlText(11), ":")(1)) <> 0 Then
            rng.Cells.Columns(lo.ListColumns("JOB ROLE").Index).Value = Split(urlText(11), ":")(1)
            End If
            
           If Split(urlText(30), ":")(1) <> "null" Or Len(Split(urlText(30), ":")(1)) <> 0 Then
            rng.Cells.Columns(lo.ListColumns("POSITION NAME").Index).Value = Split(urlText(30), ":")(1)
            End If
            
            If Split(urlText(4), ":")(1) <> "null" Or Len(Split(urlText(4), ":")(1)) <> 0 Then
            rng.Cells.Columns(lo.ListColumns("LINE MANAGER").Index).Value = Split(urlText(4), ":")(1)
            End If
            
            If Split(urlText(38), ":")(1) <> "null" Or Len(Split(urlText(38), ":")(1)) <> 0 Then
            
            rng.Cells.Columns(lo.ListColumns("COUNTRY").Index).Value = Split(urlText(38), ":")(1)
            End If
            
            If Split(urlText(22), ":")(1) <> "null" Or Len(Split(urlText(22), ":")(1)) <> 0 Then
            rng.Cells.Columns(lo.ListColumns("MOBILE").Index).Value = Split(urlText(22), ":")(1)
            End If
            
            If Split(urlText(32), ":")(1) <> "null" Or Len(Split(urlText(32), ":")(1)) <> 0 Then
            rng.Cells.Columns(lo.ListColumns("COST CENTRE").Index).Value = Split(urlText(32), ":")(1)
            End If
            
        
Application.DisplayAlerts = True

Else
rng.Cells.Columns(lo.ListColumns("UPDATE_RES_INFO").Index).Value = 3
End If
End If

DoEvents
Next lr

MsgBox ("RP Updated")

 Else
MsgBox "Please update the Authorization Key first"
End If

End Sub