Excel VBA 来自 AD 的 LDAP 查询网络打印机不显示 PortName

Question

我想使用下面的代码将我域中的所有网络打印机快速添加到 Excel 电子表格中以用于我的记录。除了不显示端口名称（IP 地址）（单元格为空白）之外，代码工作正常。

有人可以查看我下面的代码并指出为什么它不适用于 PortName 字段..

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

我使用这个旧脚本将相同的数据写入 .csv 文件。对我有用。试一试。

'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"

输出为：

Answer 2

1.问题：数据类型

您的代码无法正常工作有以下几个原因：

portName 字段存储为 DataTypeEnum 12（自动化变体：DBTYPE_VARIANT）
DBTYPE_VARIANT 不支持与 ADO (source) 一起使用。
CopyFromRecordset 存在已知数据类型问题(source)

注意：所有其他字段都存储为 DataTypeEnum 202（以 null 结尾的 Unicode 字符串）。

2。解决方案

您需要遍历记录并将 portName 导入字符串，然后将该字符串写入正确的单元格。这确保 VBA 处理转换，而不是 CopyFromRecordset 试图确定（不）正确的数据类型。如果您想保留原始代码并进行有限的修改，我在下面提供了一个基本示例。

我能够在我的机器上复制你的问题；以下修改后的代码按预期工作并包含 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

Excel VBA 来自 AD 的 LDAP 查询网络打印机不显示 PortName

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

excel

vba

active-directory

ldap-query

network-printers