How to limit the number of results in an LDAP query - ldap

I'm programming an Office 2010 Word template that needs to interact with the Active Directory, to retrieve some user info. The user filling out the template can give some input for the search that is used to retrieve the AD info.
I'm using the ADODB Recordset and Command to setup my query:
Public Function GetActiveDirectoryInfo(searchString As String) As Object
Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim strQuery, adoRecordset
'remove user input asteriks
searchString = Replace(searchString, "*", "")
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
strBase = "<LDAP://" & GLOBAL_LDAP_USER_OU & ">"
' Filter on user objects.
strFilter = "(&(objectCategory=person)(objectClass=user)(|(sn=" & searchString & "*)(cn=" & searchString & "*)))"
' Comma delimited list of attribute values to retrieve.
strAttributes = ACTIVE_DIRECTORY_FIELDS
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";OneLevel"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 10
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
'adoCommand.Properties("Maximum Rows") = 10 'error: read only
On Error GoTo err_NoConnection
' Run the query.
Set adoRecordset = adoCommand.Execute
Set foundItems = adoRecordset
Debug.Print "Found : " & foundItems.RecordCount & " records"
Exit Function
err_NoConnection:
'in case of error: return <nothing>
Debug.Print Err.description
Set GetActiveDirectoryInfo = Nothing
End Function
THis function is part of a User Class in MS Word.
My question: how to prevent the user from retrieving thousands of records? I have been reading about paging, but that seems more like a network-load-thing than actually limiting the search results that will eventually get back to me.
I've tried several things but with no results. For instance setting the MaxRecords or Maximum Rows properties. Both give an error (non existing property for the first, and read only error for the second).
ANy ideas anyone.
MS Office 2010 dutch
ADO Objects 6.0
Thanx!

Unfortunately ADO MaxRecord that limits the number of search results is not implemented for ADsDSObject. The link https://support.microsoft.com/kb/269361 details the workaround to solve the issue.

Related

How to read all attribute values in a VBA LDAP query?

I'm doing some development work and need to see what data is stored in Active Directory in order to figure out which fields are being used and may contain information that will be useful. I have a method of pulling all of the mandatory property field names, and of pulling the data with LDAP if I know what the field names are, but what I can't figure out is how to do it dynamically. Here's my code:
Function LDAPdump()
Dim objSysInfo As Object
Dim objSchema As Object
Dim objRecordset As Object
Dim objConnection As Object
Dim objCommand As Object
Dim objUser As Object
Dim objLUser As Object
Dim dname As String
Dim DLoc As Integer
Dim ADaddress As String
Set objSysInfo = CreateObject("ADSystemInfo")
Set objSchema = GetObject("LDAP://schema/user")
Set objUser = GetObject("LDAP://" & objSysInfo.UserName)
dname = objUser.distinguishedName
DLoc = InStr(dname, "DC=")
ADaddress = Right(dname, Len(dname) - DLoc + 1)
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT * FROM 'LDAP://" & ADaddress & "' WHERE objectCategory='user' AND cn='" & objUser.CN & "'"
Set objRecordset = objCommand.Execute
If objRecordset.RecordCount = 0 Then
MsgBox "no data"
Exit Function
End If
Set objLUser = GetObject(objRecordset.Fields("ADsPath").Value)
'print all mandatory property field names
For Each strAttribute In objSchema.MandatoryProperties
Debug.Print strAttribute & ": " & objLUser(CStr(strAttribute)).Value
Next
End Function
The spot that's specifically giving me issues is pulling the objLUser attribute value. For example, when I run this code the first attribute that comes up is cn. If I specifically write Debug.Print strAttribute & ": " & objLUser.cn I get cn: Chaosbydesign back in the immediate window, but when I try to dynamically get it in the For loop, I get back "The directory property cannot be found in the cache." Looking at objUser or objLUser in the Locals window doesn't provide any hints to a solution because it just says <No Variables> when expanded, even though I can go into the immediate window and type in ? objLUser.cn/mail/displayname and get my common name, email and display name back.
I have a workaround for this that involves a bit of shenanigans with a text file and Excel to basically write out the Debug.Print line for every single attribute, so this problem itself isn't a show stopper, more just an annoyance that I'd like to figure out.

VBA to query field contents in CSV

I'm struggling with ADO connections/recordsets.
My problem statement is: a function that will return the first value of a chosen field, in a chosen .csv file.
I am doing this to identify variably-named .csv files before adding the data to the relevant tables in a database. I am making the assumption that this field is always present and that either it is consistent throughout the file, or only relevant ones are grouped (this is controlled higher up the chain and is certain enough).
My code is being run as part of a module in an MS Access database:
Public Function GetFirstItem(File As Scripting.File, Field As String)
Dim Conn As ADODB.Connection, Recordset As ADODB.Recordset, SQL As String
Set Conn = New ADODB.Connection
Set Recordset = New ADODB.Recordset
'Microsoft.ACE.OLEDB.16.0 / Microsoft.Jet.OLEDB.4.0
Conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=""" & File.ParentFolder & _
"""; Extended Properties=""text;HDR=Yes;FMT=Delimited;"";"
SQL = "SELECT " & Field & " FROM """ & File.Name & """ LIMIT 1"
Debug.Print Conn.ConnectionString
Debug.Print SQL
Conn.Open
Recordset.Source = SQL
Recordset.ActiveConnection = Conn.ConnectionString
Recordset.Open
Recordset.MoveFirst
'GetFirstItem = Recordset!Questionnaire
Recordset.Close
Conn.Close
Set Recordset = Nothing
Set Conn = Nothing
End Function
ConnectionString = Provider=Microsoft.ACE.OLEDB.16.0;Data Source="D:\Documents\Jobs\TestPath"; Extended Properties="text;HDR=Yes;FMT=Delimited;";
Field = Questionnaire
SQL = SELECT Questionnaire FROM "test.csv" LIMIT 1
I get an error on Recordset.Open of:
This may be (is probably) down to a complete lack of understanding of how ADO connections/recordsets work. I have tried sans-quotes and it complains about a malformed FROM expression. Additionally, once this hurdle is overcome I am unsure of the syntax of how to return the result of my query. If there is a better way of doing this I am all ears!
Thanks.
In Access you don't need ADO library to query a CSV file:
Public Function GetFirstItem(File As Scripting.File, Field As String) As String
Dim RS As DAO.Recordset, SQL As String
SQL = "SELECT TOP 1 [" & Field & "]" _
& " FROM [" & File.Name & "]" _
& " IN '" & File.ParentFolder & "'[Text;FMT=CSVDelimited;HDR=Yes];"
Debug.Print SQL
Set RS = CurrentDb.OpenRecordset(SQL)
GetFirstItem = RS(0)
RS.Close
Set RS = Nothing
End Function
Usage:
?GetFirstItem(CreateObject("Scripting.FileSystemObject").getfile("c:\path\to\your\file.csv"), "your field")

Performing SQL queries on basic Excel 2013 worksheet as table using ADO with VBA triggers Errors

I'm developping modules on a client XLSm with 32-bits 2013 Excel.
I'd like to use datas on worksheet as if it is an Access table.
With a lot of difficulties, I think connection is now OK.
Still, I have error : 3001 Arguments are of wrong type, are out of acceptable range. Error that I cannot understand.
Here excerpts of VBA lines :
In addition, I added 20 lines in data Worksheet below the header line to permit to Excel to interpret for the type of each columns.
varCnxStr = "Data Source=" & G_sWBookREINVOICingFilePath & ";" & "Extended Properties='Excel 12.0 Xml;HDR=YES;IMEX=15';"
With conXLdb
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Mode = adModeShareExclusive
.Open varCnxStr
End With
strSQL = "SELECT * "
strSQL = strSQL & " FROM [ReInvoiceDB$B2B5072] inum "
strSQL = strSQL & " WHERE inum.InvoiceNum LIKE '1712*' "
strSQL = strSQL & ";"
'>> TRIGGERs ERROR with the current Where Clause !!'
adoXLrst.Open strSQL, conXLdb, dbOpenDynamic, adLockReadOnly, adCmdText
If adoXLrst.BOF And adoXLrst.EOF Then
'no records returned'
GoTo Veloma
End If
adoXLrst.MoveFirst
Do While Not adoXLrst.EOF
'Doing stuff with row'
adoXLrst.MoveNext
Loop
sHighestSoFar = adoXLrst(1).Value '> just to try for RecordSet : Codes are not completed...
sPrefixeCURR = Mid(sHighestSoFar, 1, 4)
Highest = CInt(Mid(sHighestSoFar, 5))
'> Increment >'
Highest = Highest + 1
HighestStr = sPrefixeCURR & Format(Highest, "00")
strGSFNumber = HighestStr
adoXLrst.Close
conXLdb.Close
Veloma:
On Error Resume Next
Set adoXLrst = Nothing
Set conXLdb = Nothing
Exit Sub
Etc.
Any idea about what seems be wrong ?
Thank you
Below is an old example I have been using successfully. Note that the sheet name in the book are Sheet1 and Sheet2, but in the query I had to use sheet1$ and sheet2$. I noticed you had $ signs in the middle of your sheet names. perhaps that's the issue ?
Sub SQLUpdateExample()
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Set con = New ADODB.Connection
con.Open "Driver={Microsoft Excel Driver (*.xls)};" & _
"DriverId=790;" & _
"Dbq=" & ThisWorkbook.FullName & ";" & _
"DefaultDir=" & ThisWorkbook.FullName & ";ReadOnly=False;"
Set rs = New ADODB.Recordset
Set rs = con.Execute("UPDATE [Sheet1$] inner join [Sheet2$] on [Sheet1$].test1 = [Sheet2$].test1 SET [Sheet1$].test3 = [Sheet2$].test2 ")
Set rs = Nothing
Set con = Nothing
End Sub
To give more details about the whole module to be implemented : it is to perform a Transaction unit.
This transaction will comprise 3 operations : get a max value from a column (Invoice number) to increment it, record the new number inside an Access table (by DAO), the same Excel file (by ADO) and generating document on HDD.
So it is aimed to use the Excel file as a table not as a file manipulated with Windows script or Excel VBA. My end user is disturbed by the pop-uping of an Excel opening file operation. As a developer, I'm feeling more comfortable with using SQL statements as much as possible inside Transaction session. Is that your opinion too ?

ADO Recordset data not showing on form

I've got a frustrating issue on MS Access 2010 that I would at this stage qualify as a bug. And after having tried all possible workarounds, I am out of ideas and rely on you.
Context
Huge Ms Access 2010 application with 25k lines of VBA and >50 forms. It has a client server architecture with a frontend compiled and an Access backend on the network. It makes connections to a twentish of different databases (Oracle/SQL Server/Sybase IQ).
The problem
Sometimes when I assign an ADODB recordset to a subform, its data isn't shown in bound fields. I've got #Name? everywhere
The data is there. I can debug.print it, I can see it in the Watches browser, I can read or manipulate it while looping on the recordset object with code. It just not appear in the subform.
It can work flawlessly during months, and suddenly one form will start having this issue without any apparent reason (it might happen even on forms that I have not changed). When it happens, it does for all users, so this is really something wrong in the frontend accdb/accde.
The issue is not related to a specific DBMS/Driver. It can happen with Oracle or Sybase data.
I have created my own class abstracting everything related to ADO connections and queries, and use the same technique everywhere. I've got several tenth of forms based on it and most of them works perfectly.
I have this issue in several parts of my application, and especially in a highly complicated form with lots of subforms and code.
On this Main form, a few subforms have the issue, while others don't. And they have the exact same parameters.
The Code
This is how I populate a form's recordset :
Set RST = Nothing
Set RST = New ADODB.Recordset
Set RST = Oracle_CON.QueryRS(SQL)
If Not RST Is Nothing Then
Set RST.ActiveConnection = Nothing
Set Form_the_form_name.Recordset = RST
End If
The code called with Oracle_CON.QueryRS(SQL) is
Public Function QueryRS(ByVal SQL As String, Optional strTitle As String) As ADODB.Recordset
Dim dbQuery As ADODB.Command
Dim Output As ADODB.Recordset
Dim dtTemp As Date
Dim strErrNumber As Long
Dim strErrDesc As String
Dim intSeconds As Long
Dim Param As Variant
If DBcon.state <> adStateOpen Then
Set QueryRS = Nothing
Else
DoCmd.Hourglass True
pLastRows = 0
pLastSQL = SQL
pLastError = ""
pLastSeconds = 0
Set dbQuery = New ADODB.Command
dbQuery.ActiveConnection = DBcon
dbQuery.CommandText = SQL
dbQuery.CommandTimeout = pTimeOut
Set Output = New ADODB.Recordset
LogIt SQL, strTitle
dtTemp = Now
On Error GoTo Query_Error
With Output
.LockType = adLockPessimistic
.CursorType = adUseClient
.CursorLocation = adUseClient
.Open dbQuery
End With
intSeconds = DateDiff("s", dtTemp, Now)
If Output.EOF Then
LogIt "-- " & Format(Now, "hh:nn:ss") & " | Executed in " & intSeconds & " second" & IIf(intSeconds = 1, "", "s") & " | Now rows returned."
Set QueryRS = Nothing
Else
Output.MoveLast
pLastRows = Output.RecordCount
LogIt "-- " & Format(Now, "hh:nn:ss") & " | Executed in " & intSeconds & " second" & IIf(intSeconds = 1, "", "s") & " | " & Output.RecordCount & " row" & IIf(Output.RecordCount = 1, "", "s") & " returned."
Output.MoveFirst
Set QueryRS = Output
End If
End If
Exit_Sub:
pLastSeconds = intSeconds
Set Output = Nothing
Set Parameter = Nothing
Set dbQuery = Nothing
DoCmd.Hourglass False
Exit Function
Query_Error:
intSeconds = DateDiff("s", dtTemp, Now)
strErrNumber = Err.Number
strErrDesc = Err.DESCRIPTION
pLastError = strErrDesc
MsgBox strErrDesc, vbCritical, "Error " & pDSN
LogIt strErrDesc, , "ERROR"
Set QueryRS = Nothing
Resume Exit_Sub
Resume
End Function
Things I tried so far
For the recordsets I tried every possible variation of
.LockType = adLockPessimistic
.CursorType = adUseClient
.CursorLocation = adUseClient
The subforms handling the recordsets have all a Snapshot recordsettype, problem remains if I try dynaset.
Dataentry, Addition, deletion, edits are all disabled. It's pure read-only.
I have a habit of disconnecting the recordsets using RST.ActiveConnection = Nothing so I can manipulate them afterwards, but this doesn't impact the problem either.
It can happens with very simple queries with only one field in the SELECT clause and only one field bound to it on a subform.
Reimporting all objects in a fresh accdb doesn't solve the problem either.
The solution proposed by random_answer_guy worked at first glance, which accreditate the bug hypothesis. Unfortunately my problems reappeared after some (totaly unrelated) changes in the main form. I am back with 4 or 5 subforms not showing data and adding/removing a Load event on all or part of them doesn't make any difference anymore
If you want more information about how weird is this issue, I advise you to read my comment on random_answer_guy's answer.
To conclude
What is extremely frustrating is that I can have 2 different forms with exactly the same properties and same fields, same SQL instruction over the same DB, same recordset management code: One is showing the data and the other doesn't !
When the problem happens, I have no other choice than erasing all objects manipulated and reimporting them from an older version or recreate them from scratch.
If this is not a bug, I am still looking for the proper word to qualify it.
Does anyone ever experienced the issue and has an explanation and/or a workaround to propose ?
I've had this same issue before and simply adding a blank Form_Load event solved the problem. No code needs to be with the Form_Load it just needs to be present.
So nobody could give at this stage a clear answer to the main question :
Why is this bug happens ?
In the meantime I have "elegantly" bypassed the issue by changing the method used for the subforms encountering the bug, from ADO to DAO.
I have created a new method in my ADO abstracting class, that actually use DAO to return a recordset (not logical, but hey...).
The code where I pass data to the form becomes :
Set RST = Nothing
Set RST = Oracle_CON.QueryDAORS(SQL)
If Not RST Is Nothing Then
Set Form_the_form_name.Recordset = RST
End If
And here's the method QueryDAORS called :
Public Function QueryDAORS(ByVal SQL As String, Optional strTitle As String) As DAO.Recordset
Dim RS As DAO.Recordset
Dim dtTemp As Date
Dim strErrNumber As Long
Dim strErrDesc As String
Dim intSeconds As Long
Dim Param As Variant
On Error GoTo Query_Error
dtTemp = Now
If DBcon.state <> adStateOpen Then
Set QueryDAORS = Nothing
Else
DoCmd.Hourglass True
Set pQDEF = CurrentDb.CreateQueryDef("")
pQDEF.Connect = pPassThroughString
pQDEF.ODBCTimeout = pTimeOut
pQDEF.SQL = SQL
pLastRows = 0
pLastSQL = SQL
pLastError = ""
pLastSeconds = 0
LogIt SQL, strTitle, , True
Set RS = pQDEF.OpenRecordset(dbOpenSnapshot)
intSeconds = DateDiff("s", dtTemp, Now)
If RS.EOF Then
LogIt "-- " & Format(Now, "hh:nn:ss") & " | Executed in " & intSeconds & " second" & IIf(intSeconds = 1, "", "s") & " | Now rows returned."
Set QueryDAORS = Nothing
Else
RS.MoveLast
pLastRows = RS.RecordCount
LogIt "-- " & Format(Now, "hh:nn:ss") & " | Executed in " & intSeconds & " second" & IIf(intSeconds = 1, "", "s") & " | " & RS.RecordCount & " row" & IIf(RS.RecordCount = 1, "", "s") & " returned."
RS.MoveFirst
Set QueryDAORS = RS
End If
End If
Exit_Sub:
pLastSeconds = intSeconds
Set RS = Nothing
DoCmd.Hourglass False
Exit Function
Query_Error:
intSeconds = DateDiff("s", dtTemp, Now)
strErrNumber = Err.Number
strErrDesc = Err.DESCRIPTION
pLastError = strErrDesc
MsgBox strErrDesc, vbCritical, "Error " & pDSN
LogIt strErrDesc, , "ERROR"
Set QueryDAORS = Nothing
Resume Exit_Sub
Resume
End Function
The property pPassThroughString is defined with another Method using the properties that I already had at my disposal in the class, because they were neccessary to open an ADO connection to the database :
Private Function pPassThroughString() As String
Select Case pRDBMS
Case "Oracle"
pPassThroughString = "ODBC;DSN=" & pDSN & ";UID=" & pUsername & ";Pwd=" & XorC(pXPassword, CYPHER_KEY)
Case "MS SQL"
pPassThroughString = "ODBC;DSN=" & pDSN & ";DATABASE=" & pDBname & ";Trusted_Connection=Yes"
Case "Sybase"
pPassThroughString = "ODBC;DSN=" & pDSN & ";"
Case Else
MsgBox "RDBMS empty ! ", vbExclamation
LogIt "RDBMS empty ! ", , "ERROR"
End Select
End Function
So the issue was solved rapidly by just changing the recordset assigned to the forms from ADODB.Recordset to DAO.recordset and adapting the method called from .OpenRS to .OpenDAORS.
The only con is that with DAO I can't use this anymore to disconnect the recordset:
Set RST.ActiveConnection = Nothing
Still, I would have prefered to get an explanation and fix :(

Querying Excel by multiple users - Need suggestion

I am seeking one suggestion on how to build an excel macro for below requirement. Request you to provide your valuable comments in EXCEL Only.
Scenario
I have one spreadsheet "Product Master" that contains all the product details.
(i.e. Product ID,Product Name,Product Type,Quantity etc etc)
I am designing a UserForm using excel VBA where anyone can fetch all the details of a product based on its Product ID. Now the product-master sheet where all the product details is present will get updated on a daily basis. And each user should be able to update any details in that sheet based on his requirement.
Questions/Doubts
How do I design my system? I mean where should I put my "Product-Master" spreadsheet so that it can be accessed by multiple users. What I am thinking is to put product-masster on a shared_drive so that all can access that sheet through VBA userform. I will provide excel VBA userform macro to everyone in my office & they will query that sheet present in shared drive. does this seem ok?
Does excel provide facility to Query data from sheet present in shared-drive & update it when required. And I want this to be queried by multiple users at a time.
I know there are other products/technologies that provides better solution than EXCEL. But I want the solution in EXCEL ONLY.
I would appreciate it if anyone can provide his/her valuable comments on this. Let me know in case you need any details.
Thanks you.
Here are some example functions getting data from/posting data to MS Access (took me awhile to dig these up, hah!). This uses a Reference to the Microsoft DAO 3.6 Object Library and will only work with legacy .mdb files, not accdb (because the mdb driver is 100x faster and doesn't have a memory leak.)
Const DBPath As String = "Full\Database\Path"
Function GET_ACCESS_DATA(DBPath, SQL) As Object
Dim dbConn As Object
Dim dbRS As Object
Dim SQL As String
On Error GoTo ErrorHandler
SQL = "Sql Query"
'Set up database connection string
Application.StatusBar = "Connecting to Database..."
'Open database connection
Set dbConn = OpenDatabase(DBPath)
'Run the query
Application.StatusBar = "Running Query..."
Set dbRS = dbConn.OpenRecordset(SQL, DAO.dbOpenForwardOnly, DAO.RecordsetOptionEnum.dbReadOnly)
'If no rows returned, display error message and exit
If dbRS.RecordCount = 0 Then
Application.StatusBar = "Running Query...Error"
MsgBox "There are no records for the selected criteria.", vbInformation, "Refresh Data"
Application.StatusBar = "REFRESHING DATA PLEASE WAIT.."
Exit Function
End If
'returns DAO Recordset with the data
Set GET_ACCESS_DATA = dbRS
'A recordset can either be looped through or pasted to a spreadsheet with the Worksheet.Range.CopyFromRecordset method
'Error trap here
End Function
Function POST_TO_ACCESS() As Boolean
POST_TO_ACCESS = False
errormod = "TRACKING"
On Error GoTo ERROR_TRAP:
'START CONTROLS
Application.StatusBar = "Formatting Data"
St_Timer = Timer 'start connection timer
Dim cn As DAO.Database
Set cn = DAO.OpenDatabase(DBPath)
En_Timer = Timer 'get connection time
'SetKey Parameters
UserNM = Replace(User_Name(), Chr(39), "")
CompNm = Environ("COMPUTERNAME")
Elapsed_Time = En_Timer - St_Timer
SQL = "INSERT INTO TBL_TRACKING " & _
"(UserNM) " & _
" VALUES ('" & UserNM & "')"
cn.Execute SQL
cn.Close
'END CONTROLS
Application.StatusBar = False
POST_TO_ACCESS = True
'error trap here
End Function
Function User_Name()
'This just gets the LDAP username of whoever is logged in. Useful for tracking. Not guarenteed to work for your Active Directory :)
Dim WshNetwork
Dim objAdoCon, objAdoCmd, objAdoRS
Dim objUser, objRootDSE
Dim strDomainDN, strUserName, strUserFullName
strUserFullName = ""
Set WshNetwork = CreateObject("WScript.Network")
strUserName = WshNetwork.UserName
Set objRootDSE = GetObject("LDAP://rootDSE")
strDomainDN = objRootDSE.Get("defaultNamingContext")
Set objAdoCon = CreateObject("ADODB.Connection")
objAdoCon.Open "Provider=ADsDSOObject;"
Set objAdoCmd = CreateObject("ADODB.Command")
Set objAdoCmd.ActiveConnection = objAdoCon
objAdoCmd.CommandText = _
"SELECT ADsPath FROM 'LDAP://" & strDomainDN & "' WHERE " & _
"objectCategory='person' AND objectClass='user' AND " & _
"sAMAccountName='" & strUserName & "'"
Set objAdoRS = objAdoCmd.Execute
If (Not objAdoRS.EOF) Then
Set objUser = GetObject(objAdoRS.Fields("ADsPath").Value)
objUser.GetInfoEx Array("displayName"), 0
strUserFullName = objUser.Get("displayName")
Set objUser = Nothing
User_Name = strUserFullName
Else
End If
Set objAdoRS = Nothing
Set objAdoCmd = Nothing
objAdoCon.Close
Set objAdoCon = Nothing
Set objRootDSE = Nothing
Set WshNetwork = Nothing
End Function