How to convert VBA Function to normal MAcro

[Negi1984]

Hi All,

I have function Macro created by someone else. Now I want to convert it to normal macro. I tried myself to change but its giving me error messages "Run time error 3704".

Can anybody help me out. Below is the original Function code & my code both where I am getting error .

[CODE]
Function getSignumFromEmployeeID(SearchString) As String
Set cmd = CreateObject("ADODB.Command")
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
    
cn.Open "Provider=ADsDSOObject;"


     
    cmd.CommandText = "SELECT cn From 'LDAP://XX=XX,OU=XXXX,OU=XXXX,OU=ID,OU=Data,DC=XXXXXXX,DC=XX' " & _
                      "WHERE employeeID ='" & SearchString & "'  and objectClass='Person' and objectClass ='user' and objectClass='Top' and objectClass ='organizationalPerson' and employeeType ='Workforce'  "
    
    cmd.ActiveConnection = cn
    Set rs = cmd.Execute
    
    i = 0
    
    'cn : signum
    'UserPrincipalName : email address
    While rs.EOF <> True And rs.BOF <> True
        getSignumFromEmployeeID = rs.Fields("cn").Value + ""
        rs.MoveNext
        i = i + 1
    Wend
    
    cn.Close
    
    If i = 0 Then
        getSignumFromEmployeeID = "Not Found"
    End If


End Function

[/CODE]


My Code where I am getting error. Note : List of reference I am searching is start from sheet1 range B5 and output I want to print from C5 onwards till last row.

Sub Per()


Dim getSignumFromEmployeeID As String
Set cmd = CreateObject("ADODB.Command")
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")


cn.Open "Provider=ADsDSOObject;"


    Range("B5").Select
    Do Until IsEmpty(ActiveCell)


    i = 0
    r = 5


     
    cmd.CommandText = "SELECT cn From 'LDAP://XX=XX,OU=XXXX,OU=XXXX,OU=ID,OU=Data,DC=XXXXXXX,DC=XX' " & _
                      "WHERE employeeID ='" & SearchString & "'  and objectClass='Person' and objectClass ='user' and objectClass='Top' and objectClass ='organizationalPerson' and employeeType ='Workforce'  "
    
    cmd.ActiveConnection = cn
    'Set rs = cmd.Execute
    
        
    'cn : signum
    'UserPrincipalName : email address
    While rs.EOF <> True And rs.BOF <> True
        
     If IsEmpty(getSignumFromEmployeeID = rs.Fields("cn").Value + "") Then
     Cells(r, 3).Value = "Not Found"
     Else
     getSignumFromEmployeeID = rs.Fields("cn").Value + ""
     Cells(r, 3).Value = getSignumFromEmployeeID
     rs.MoveNext
     i = i + 1
    End If
    Wend
    
    cn.Close


Loop
Cells(1, 1).Select


End Sub

 

[John_w]

Untested, but try the following changes:

1. Move the Loop statement above cn.Close
2. Immediately before the Loop statement, add ActiveCell.Offset(1).Select
3. Change the Cells(r, 3) statements to:

        ActiveCell.Offset(, 1).Value = "Not Found"
        ActiveCell.Offset(, 1).Value = getSignumFromEmployeeID