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

score 3 · Accepted Answer · edited May 23 '17 at 11:50

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

score 1 · Answer 2 · answered Feb 28 '16 at 11:44

I use this old script to write same data to .csv file. Works good for me. Give it a try.

'Query AD for Printer details form printer name
ReportLog = "OutPut.csv"
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objOut : Set objOut = objFSO.CreateTextFile(ReportLog)
objOut.WriteLine "Dis Name;printer name;port name;Location;Server name;"

Set objRootDSE = GetObject("LDAP://rootDSE")
strADsPath = "<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">"
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOOBject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection

strFilter = "(&(objectClass=printQueue))"
strAttributes = "distinguishedName,printShareName,portName,location,servername"

strQuery = strADsPath & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 300
objCommand.Properties("Cache Results") = False
Set objRecordSet = objCommand.Execute
'objRecordSet.MoveFirst

Do Until objRecordSet.EOF
    strDN = "<ERROR>"
    strPSN = "<ERROR>"
    strPN = "<ERROR>"
    strLO = "<ERROR>"
    strSN = "<ERROR>"
    On Error Resume Next
    strDN = objRecordSet.Fields("distinguishedName")
    strPSN = objRecordSet.Fields("printShareName")
    strPN = objRecordSet.Fields("portName")
    strLO = objRecordSet.Fields("location")
    strSN = objRecordSet.Fields("serverName")
    Err.Clear
    On Error GoTo 0
    objOut.WriteLine """" & strDN & """;""" & Join(strPSN, ";") & """;""" & Join(strPN, ";") & """;""" & strLO & """;""" & strSN & """"
    objRecordSet.MoveNext
Loop    
'Next

objOut.Close
WScript.Echo "Finished"

The output is:

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

2 Answers2