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

我想使用下面的代码将我的域中的所有网络打印机快速添加到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

---

我使用这个旧脚本将相同的数据写入

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

“从打印机名称查询打印机详细信息”
ReportLog=“OutPut.csv”
Dim objFSO:Set objFSO=CreateObject（“Scripting.FileSystemObject”）
Dim objOut:Set objOut=objFSO.CreateTextFile（ReportLog）
objOut.WriteLine“Dis名称；打印机名称；端口名称；位置；服务器名称
设置objRootDSE=GetObject（“LDAP://rootDSE”）
斯特拉斯帕特=“”
设置objConnection=CreateObject（“ADODB.Connection”）
设置objCommand=CreateObject（“ADODB.Command”）
objConnection.Provider=“ADsDSOOBject”
objConnection.打开“Active Directory提供程序”
设置objCommand.ActiveConnection=objConnection
strFilter=“（&（objectClass=printQueue））”
StratAttributes=“DifferentiedName、printShareName、portName、location、servername”
strQuery=strADsPath&“；”&strFilter&“；”&strAttributes&“子树”
objCommand.CommandText=strQuery
objCommand.Properties（“页面大小”）=1000
objCommand.Properties（“超时”）=300
objCommand.Properties（“缓存结果”）=False
Set objRecordSet=objCommand.Execute
'objRecordSet.MoveFirst
直到objRecordSet.EOF为止
strnd=“”
strPSN=“”
strPN=“”
strLO=“”
strSN=“”
出错时继续下一步
strnd=objRecordSet.Fields（“区分名称”）
strPSN=objRecordSet.Fields（“printShareName”）
strPN=objRecordSet.Fields（“端口名”）
strLO=objRecordSet.Fields（“位置”）
strSN=objRecordSet.Fields（“服务器名”）
呃，明白了
错误转到0
objOut.WriteLine“”&strnd&“；”&Join（strPSN，“；”&“；”&Join（strPN，“；”&“；”&strLO&“；”&strSN&“）
objRecordSet.MoveNext
环
”“接着呢
目标关闭
Echo“已完成”

输出为：

---

1。问题：数据类型

由于以下几个原因，您的代码无法工作：

• portName字段存储为DataTypeEnum 12（自动化变量：DBTYPE\U Variant）
• DBTYPE_变量不支持与ADO（）一起使用
• CopyFromRecordset存在已知的数据类型问题（）

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

2。解决方案

您需要遍历记录并将端口名导入字符串，然后将该字符串写入正确的单元格。这可确保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