I'm looking for the way to search users in Active Directory using VBScript. I can search by username or any Active Directory using ADODB Connection:
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = ("ADsDSOObject")
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
objCommand.Properties("SearchScope") = 2
objCommand.CommandText = "SELECT userWorkstations,sAMAccountName,Mail,name,DisplayName,distinguishedName FROM 'LDAP://dc=NESTLE,dc=com' WHERE objectCategory='user' AND name='" & VaR5 & "'"
Set objRecordSet = objCommand.Execute
But I'd like to find a user with his full name, for example "John Doe" (User:Jdoe). So like in the AD Users and Computers interface we could search by "John Doe".
Change
"... name='" & var5 & "'"
to either
"... displayName='" & var5 & "'"
or
"... sn='" & lastname & "' and givenName='" & firstname & "'"
For the latter you need 2 variables: one with the first and the other with the last name.
Ok it seems to work by workaround Using Outlook Function
Dim myOlApp
Dim myOlNameSpace
Dim objFolder
Set myOlApp = CreateObject("Outlook.Application")
Set myOlNameSpace = myOlApp.GetNamespace("MAPI")
Set myRecipient = myOlNameSpace.CreateRecipient("Martin Pierre-François")
myRecipient.Resolve
msgbox myRecipient
And after I do my search in AD with displayName Attribute
Thanks For All
Related
I am working on an Access database with VBA, which needs to obtain data from an Excel workbook.
I need to assign a variable to the open book (set g_xl = ????) without opening another Excel instance (appoint to opened workbook).
Sub AssignVariableToExcelApplication()
Dim g_xl As Excel.Application
Dim strComputer As String
Dim objWMIService As Object
Dim colitems As Object
Dim objitem As Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colitems = objWMIService.ExecQuery("SELECT * FROM Win32_Process", , 48)
Dim row As Integer
row = 1
For Each objitem In colitems
If objitem.Name = "EXCEL.EXE" Then
Debug.Print objitem.ProcessID & vbCrLf & _
objitem.Name & vbCrLf & _
objitem.Caption & vbCrLf & _
objitem.CommandLine & vbCrLf & _
objitem.ExecutablePath
'This is the question
'Set g_xl = objitem ?????? (I need that g_xl appoints to objitem)
Exit For
End If
Next
End Sub
You don't need any of this, only the full path to the Excel file. Then GetObject() can get a reference to the open workbook.
sPath = "C:\my\path\myWorkbook.xlsx"
Set wb = GetObject(sPath)
' Demo
Debug.Print wb.Sheets(1).Cells(1,1).Value
' If you need the Application
Set g_xl = wb.Application
This will only start a new Excel instance, if the file isn't open.
With g_xl as type Excel.Application, that commented line is going to be
Set g_xl = CreateObject("Excel.Application")
or
Set g_xl = GetObject("Excel.Application")
The latter will hook up with an existing Excel.Application which is what I think you're trying to do. It will create a new instance if an existing one isn't found.
I am trying to obtain the manager of the user found in AD using Excel VBA. The code is as follows:
Sub ADQuery()
MsgBox GetDepartment("Simpson", "Homer")
End Sub
Function GetDepartment(strLastName As String, strFirstName As String) As String
Dim objRoot As Object
Dim strDomain As String
Dim objConn As Object
Dim objComm As Object
Dim objRecordset As Object
Dim sFilter As String
Dim sAttribs As String
Dim sDepth As String
Dim sBase As String
Dim sQuery As String
Set objRoot = GetObject("LDAP://RootDSE")
strDomain = objRoot.Get("DefaultNamingContext")
Set objConn = CreateObject("ADODB.Connection")
Set objComm = CreateObject("ADODB.Command")
strLastName = Replace(strLastName, Space(1), "")
strFirstName = Replace(strFirstName, Space(1), "")
sFilter = "(&(objectClass=person)(objectCategory=user)(givenName=" & strFirstName & ")" & "(sn=" & strLastName & "*)" & ")"
sAttribs = "manager,sAMAccountName,givenName,sn"
sDepth = "SubTree"
sBase = "<LDAP://" & strDomain & ">"
sQuery = sBase & ";" & sFilter & ";" & sAttribs & ";" & sDepth
objConn.Open "Data Source=Active Directory Provider;Provider=ADsDSOObject"
Set objComm.ActiveConnection = objConn
objComm.Properties("Page Size") = 40000
objComm.CommandText = sQuery
Set objRecordset = objComm.Execute
Do Until objRecordset.EOF
GetDepartment = objRecordset("department")
Exit Function
objRecordset.MoveNext
Loop
End Function
But I get the following error message:
Run-time error '3265': Item cannot be found in the collection corresponding to the requested name or ordinal.
Looking in AD itself, it seems the 'manager' attribute listed in the Attribute Editor is listed with a value:
CN=Burns\, Montgomery,OU=Users,OU=Springfield,OU=Nuclear Power Plant,DC=powerplantnet,DC=com
And the syntax is Distinguished Name.
My function returns a string and I can see that the manager attribute is not a string. How do I get the information back as a string?
I am trying to do a Join on 3 tables in Excel through VBA using Microsoft.ACE.OLEDB.12.0. Having lots of issues trying to get the query to run. At this point I get the following error:
Run-time error '-2147217865 (800040e37)':
The Microsoft Access database engine could not find the object 'CustomSheetName1$A$1:$AV$6027'. Make sure the object exists and that you spell its name and the path name correctly. If 'CustomSheetName1$A$1:$AV$6027' is not a local object, check your network connection or contact the server administrator.
The source file is created in the same sub and saved to the macro root folder located locally in C:\Users\localuser\Documents\MacroFolder\. I have full access to the file.
When run the connection string shows as:
"Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\localuser\Documents\MacroFolder\Book4.xlsx;Extended Properties='Excel 12.0 Xml;HDR=Yes;IMEX=1';"
Extract of sub below. I have obfuscated the field names and only included code I thought was relevant. Can add more and clarify further if required. Code breaks at the last line when executing the query.
Dim wbTarget As Workbook, wsTarget As Worksheet
Dim wb As Workbook, ws As Worksheet
Set wbTarget = Workbooks.Add
Set wsTarget = wbTarget.Sheets.Add(After:=wbTarget.Sheets(wbTarget.Sheets.Count))
wsTarget.Name = "CustomSheetName1"
varFilePathElements = Split(ThisWorkbook.Path, "\")
strFileName = varFilePathElements(UBound(varFilePathElements))
Dim strWBTargetFullFileName As String
strWBTargetFullFileName = Replace(ThisWorkbook.Path, "strfilename", "") & "\" & wbTarget.Name & ".xlsx"
Dim cn As Object
Dim rs As Object
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strWBTargetFullFileName _
& ";Extended Properties='Excel 12.0 Xml;HDR=Yes;IMEX=1';"
strSQL = "SELECT " _
& "sh1.company_name, " _
& "sh1.company_type, " _
& "sh1.customer_no, " _
& "sh1.fk1, " _
& "SUM(sh3.total_stat) as total_stat, " _
& "FROM ( [CustomSheetName1" & wbTarget.Sheets("CustomSheetName1").UsedRange.Address & "] sh1 " _
& "LEFT JOIN [CustomSheetName2" & wbTarget.Sheets("CustomSheetName2").UsedRange.Address & "] sh2 " _
& "ON sh2.fk1 = sh1.fk1 ) " _
& "LEFT JOIN [CustomSheetName3" & wbTarget.Sheets("CustomSheetName3").UsedRange.Address & "] sh3 " _
& "ON sh3.fk2 = sh2.fk2 AND sh3.fk3 = sh2.fk3 " _
& "GROUP BY sh1.customer_no, sh1.company_name, sh1.company_type, sh1.fk1 " _
& "ORDER BY total_stat"
wbTarget.Sheets(1).Range("A1").Value2 = strSQL
wbTarget.SaveAs (strWBTargetFullFileName)
wbTarget.Close
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
rs.Open strSQL, cn, 3, 3
Any help would be greatly appreciated. Regards,
When reading Excel worksheets via ADO, the $ sign is appended to the end of the worksheet name, like this:
SELECT * FROM [Sheet1$]
Using the absolute range address adds extra $ signs that cause the worksheet name to be interpreted incorrectly. You need to use non-absolute range addresses to stop this happening. Adding some parameters to UsedRange.Address can fix this:
[CustomSheetName1$" & wbTarget.Sheets("CustomSheetName1").UsedRange.Address(False, False) & "]
I have Googled without much luck. Basically each creation of a excel spreadsheet (based on a template), needs to be password protected. Can this be done?
'______________________CreateExcel()____________________________________
Function CreateExcel()
SELECT DATA FROM SQL TABLE
If objStructure.BOF = False And objStructure.EOF = False Then
Do While objStructure.EOF = False
Call CreateActualExcel()
objRsExcel.Fields("Field") = objStructure.Fields("Field")
objStructure.MoveNext
Loop
End If
End Function
'......................End CreateExcel()..................................
'______________________CreateActualExcel()________________________________
Sub CreateActualExcel()
Dim objSFSO
Dim strCon, strSQL
strFile = " Staffing_List_" & Clng(Timer()) & ".xls"
Set objSFSO = CreateObject("Scripting.FileSystemObject")
objSFSO.CopyFile conFolder & conTemplate, conFolder & strFile
Set objSFSO = Nothing
Set objRsExcel = CreateObject("ADODB.RecordSet")
strCon = _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
conFolder & strFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes;maxscanrows=1;"";"
strSQL = "Select * From [Sheet1$]"
objRsExcel.Open strSql, strCon, 3, 2
End Sub
'......................End CreateActualExcel()............................
Thanks in advance for any help.
Clare :-)
I think you can pass the password as an additional parameter when you save the file.
excelObj.SaveAs "C:\Example.xls",,"your-password"
I haven't tested this but I found this blog post about it:
http://qtp.blogspot.co.uk/2010/04/vbscript-excel-password-protect.html
I am trying to import data from Access to Excel based on two parameters. I have a list of tools which specify a project number (parameter 1) and a tool type (parameter 2). How can I filter out the tools that don't satisfy the user's input of these two parameters?
I saw this thread: Import to Excel from Access table based on parameters
but it doesn't talk about multiple parameters. Here is where I am at so far:
Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer
''Access database
strFile = "D:\Tool_Database\Tool_Database.mdb"
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";"
''Late binding, so no reference is needed
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
'Find the name of the tool that was selected
Dim SelectedTool As String, SelectedProj
Set SelectedTool = Tools_ListBox.Selected
Set SelectedProj = Project_ListBox.Selected
strSQL = "SELECT * " _
& "FROM ToolFiles " _
& "WHERE Tool_Name = '" & SelectedTool & "'"
rs.Open strSQL, cn, 3, 3
Worksheets("ToolList").Cells(2, 1).CopyFromRecordset rs
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
Obviously the strSQL statement is where I need to get focused and insert the value into SelectedProj.
Thanks!
If you just wanted to add the SelectedProj to the SQL statement, this should be the trick (where ProjectType is the name of the field):
strSQL = "SELECT * " _
& "FROM ToolFiles " _
& "WHERE Tool_Name = '" & SelectedTool & "' " _
& "AND ProjectType = '" & SelectedProj & "'"
The selected property returns True if the item is selected which doesn't make sense in your example above. Perhaps you are looking for something like
SelectedTool = Tools_listbox.Items(Tools_listbox.SelectedItem)
Note you also do not have a declaration for SelectedTool which is naughty but I guess it should be a string in which case you should not use the Set.