Excel VBA LDAP query Network Printers from AD does not display PortName

Question

I want to use the code below to quickly add all network printers from my domain into an Excel spreadsheet to use for my records. The code works fine except for the fact that the PortName (IP Address) is not displayed (cells are blank).

Could someone look over my code bellow and point out why is it not working for the PortName field..

Private Sub GetAllPrintersFromAD()
    Const ADS_SCOPE_SUBTREE = 2
    Set objRoot = GetObject("LDAP://rootDSE")
    strDomain = objRoot.Get("defaultNamingContext")

    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"

    Set objCommand.ActiveConnection = objConnection

    objCommand.CommandText = _
    "SELECT distinguishedName,portName,location,servername FROM 'LDAP://" & strDomain & "' WHERE objectClass='printQueue'"


    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

    Set objRecordSet = objCommand.Execute

    ActiveSheet.Range("A2").CopyFromRecordset objRecordSet
    objRecordSet.Close
    objConnection.Close
End Sub

Answer 1

1. Problem: Data types

Your code is not working for a few reasons:

• The portName field is stored as DataTypeEnum 12 (Automation Variant: DBTYPE_VARIANT)
• DBTYPE_VARIANT is unsupported for usage with ADO (source).
• CopyFromRecordset has known data type issues (source)

Note: all other fields are stored as DataTypeEnum 202 (null-terminated Unicode character string).

2. Solution

You will need to iterate through the records and import the portName to a string, then write that string to the correct cell. This ensures that VBA handles the conversion, rather than CopyFromRecordset attempting to determine the (in)correct data type. If you would like to keep your original code with limited modification, I've provided a rudimentary example below.

I was able to duplicate your issue on my machine; the below modified code works as intended and includes the IP.

Private Sub GetAllPrintersFromAD()
    Const ADS_SCOPE_SUBTREE = 2
    Set objRoot = GetObject("LDAP://rootDSE")
    strDomain = objRoot.Get("defaultNamingContext")

    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"

    Set objCommand.ActiveConnection = objConnection

    objCommand.CommandText = _
    "SELECT distinguishedName,portName,location,servername FROM 'LDAP://" & strDomain & "' WHERE objectClass='printQueue'"


    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

    Set objRecordSet = objCommand.Execute

    ActiveSheet.Range("A2").CopyFromRecordset objRecordSet

    'Copy over the portName field properly
    objRecordSet.MoveFirst
    i = 2
    Do Until objRecordSet.EOF
        strportname = vbNullString
        On Error Resume Next
        strportname = objRecordSet.Fields("portName")
        Err.Clear
        On Error GoTo 0
        ActiveSheet.Range("B" & i).Value2 = strportname
        i = i + 1
        objRecordSet.MoveNext
    Loop

    objRecordSet.Close
    objConnection.Close
End Sub