Excel VBA 来自 AD 的 LDAP 查询网络打印机不显示 PortName
Excel VBA LDAP query Network Printers from AD does not display PortName
我想使用下面的代码将我域中的所有网络打印机快速添加到 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"
输出为:
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 电子表格中以用于我的记录。除了不显示端口名称(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"
输出为:
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