I have a script that connects to AD and queries LDAP. The script works as long as you have the proper credentials and are connected to AD. This script runs with a variety of subs and I am trying to make the script more robust to be able to run in multiple environment that may not have AD.
On Error Resume Next
Dim tempResult
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.CommandTimeout = 10
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"
' Filter on user objects.
strFilter = ""
' Comma delimited list of attribute values to retrieve.
strAttributes = "comment,c,co,countryCode,department,description,directReports,displayName,distinguishedName,info,lastLogon,lastLogonTimestamp,mail,manager,memberOf,msExchHomeServerName,name,objectCategory,objectClass,operatingSystem,operatingSystemServicePack,operatingSystemVersion,ou,pwdLastSet,sAMAccountName,title,userAccountControl,userPrincipalName"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
if Err<>0 Then
'log error information
End If
Err.Clear
On Error GoTo 0
However when i have the script wrapped in the On Error Resume Next the script will hang when running on a machine that isn't connected to AD or doesn't have sufficient privileges on AD. Any ideas to be able to make this portion of the script run and continue if there is an error? Again if there is an error i don't care about getting any results i just want the script to continue on it's merry way.
Related
my problem is:
when i run my user creation script at my server, it works fine, a user gets created and has a membership (according to a .txt file)
when i run that same script outside of my server, the user gets created but doesnt have memberships
when i run that same script as admin outside of my server, the user gets created but doesnt have memberships
so this is the relevant code that adds memberships:
Dim fso, f, Row, Field
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile ("\\some\folder\user.txt",1,0)
Do while not f.AtEndOfLine
Row = f.readLine
Field = split(Row,",")
Username = Field(0)
Group = Field(1)
Lastname = Field(2)
Password = Field(3)
ScriptP = Field(4)
Project = Field(5)
Call UserCreation(Username,Group,Lastname,Password,ScriptP)
Loop
f.Close
Wscript.Quit(0)
Sub UserCreation (Username,Group,Lastname,Password,ScriptP)
Dim ouo, b
Set ouo = GetObject("LDAP://OU=abcOU,DC=my,DC=domain")
Set b = ouo.Create("user", "CN=" & Group & " " & Lastname)
Dim WshShell, ret
Set WshShell = WScript.CreateObject("WScript.Shell")
b.Put "sAMAccountName", Username
b.Put "userPrincipalName", Username & "#my.domain"
b.Put "scriptPath", ScriptP
b.SetInfo
b.SetPassword Password
b.AccountDisabled = False
b.SetInfo
cmdbegin = "cmd /C dsmod group"
CN = "CN=TN_" & Project & ",OU=projectOU,DC=my,DC=domain"
oudc = "OU=abcOU,DC=my,DC=domain"
cmdmid = "-addmbr"
grpadd = cmdbegin & " " & AddQuotes(CN) & " " & cmdmid & " " & AddQuotes("CN=" & Group & " " & Lastname & "," & oudc) & " >>\\some\folder\log.txt"
WshShell.Run grpadd
that log.txt just adds a row like this at completion:
dsmod was successful:CN=TN_Test,OU=projectOU,DC=my,DC=domain
The root of the problem is likely that dsmod is not installed on the computer you're running this from, since the documentation says that it is only installed by default on domain controllers. That can be confirmed by just running dsmod from the command line.
But that also seems like the hard way to do it. You can replace everything from the cmdbegin line to the end with this:
Set group = GetObject("LDAP://CN=TN_" & Project & ",OU=projectOU,DC=my,DC=domain")
group.Add(b.aDSPath)
The group variable will be a IADsGroup object, so you can use its Add method to add the user.
I am trying to write a VBScript to delete specific user account from server.
If in server found the users "adm" and/or "ame" the script should delete them and also print the result whether the deletion was successful or not.
Below is the script which I tried writing and I am getting an error. Can anyone help me to correct this?
Dim disuser, objNetwork, strComputer, objComputer
Set objNetwork = CreateObject("Wscript.Network")
strComputer = objNetwork.ComputerName
Set objComputer = GetObject("WinNT://" & strComputer)
On Error Resume Next
For Each disuser In "adm ame"
Call objComputer.Delete("user", disuser)
On Error GoTo 0
Next
'On Error res="fail"
If you want to pass multiple usernames as a list this is fine, but to enumerate them using a For Each they need to be enumerable in other words an object that supports enumeration like an Array or Collection.
Dim disuser, objNetwork, strComputer, objComputer
Set objNetwork = CreateObject("Wscript.Network")
strComputer = objNetwork.ComputerName
Set objComputer = GetObject("WinNT://" & strComputer)
On Error Resume Next
'Split list of space delimited usernames into an Array.
Dim list: list = Split("adm ame", Chr(32))
For Each disuser In list
'Clear previous error before checking if the Delete works.
Call Err.Clear()
Call objComputer.Delete("user", disuser)
If Err.Number = 0 Then
'Was successful do something
Else
'Failed do something
End If
Next
On Error GoTo 0
'On Error res="fail"
I'm trying to get hold of running instances of MS Access 2010+ (on Win10) but the usual tip; GetObject(, "Access.Application") ... for works only for hidden instances started by myself with script, but not any instances started from GUI by the user.
And yes, I've read perhaps ten or more google hits on the subject, both on WMI and GetObject, but I seem to have missed something important.
However, I've tried the code below and I can get hold of any process of running Access instances in this way, and I can even .terminate() them, but, that's not what I want to do. Instead I want to grab the process and assign it to a usable (correct type) Access variable (see "OutInstance" in the code below) :
[Edit: Using WHERE clause, and skipped Exit as to retrieve the last instance]
Public Function GetRunningInstance(sAppName sComputer, ByRef OutInstance)
Dim oWMIService
Dim wProcesses
Dim oPrc
GetRunningInstance = False
Set OutInstance = Nothing
if sComputer = "" then sComputer = "."
Set oWMIService = GetObject("winmgmts:" & "{impersonationLevel=" & _
"impersonate}!\\" & sComputer & "\root\cimv2")
Set wProcesses = oWMIService.ExecQuery ("SELECT * FROM Win32_Process " & _
"WHERE Name = '" & sAppName & "'")
For Each oPrc in wProcesses
''' oPrc.Terminate() ''' Works, I can shut down Access...
Set OutInstance = oPrc
GetRunningInstance = True
''' By not exiting we get the last instance.
Next
End Function
Now, after trying to get hold of an instance, how do I "cast" the process to a usable Access application variable in this VBScript?
Sub Test_DoStuff()
Dim InstProc
Dim AccessApp
If GetRunningInstance("msaccess.exe", "127.0.0.1", InstProc) Then
Set AccessApp = ''' cast 'InstProc' to my "Access.Application" somehow?
Else
Set AccessApp = CreateObject("Access.Application")
End If
'''
''' Doing my stuff
'''
AccessApp.CloseCurrentDatabase
AccessApp.DoCmd.Quit
End Sub
Test
I (also) don't understand why GetObject(, "Access.Application") doesn't work in all cases. Permissions? (I understand that it's 'unsafe' to close a database currently being used by a user, but also that can be dealt with).
// Rolf
When I run the following script on it's own by double clicking, it works just fine. It returns the last logged on user as expected. But when I run it from the HTA I have been developing as a front end to all of my scripts, I get a type mismatch error on the "wscript.echo strvalue" line. I have tried everything to get it to work, like changing permissions on mshta.exe to full control for myself. I simply can't get it to run from the HTA without getting an error, but it works 100% as expected on its own. I am completely stumped.
strinput = "myserver"
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strinput & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Authentication\LogonUI"
strValueName = "LastLoggedOnUser"
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
Wscript.Echo strValue
By default, Windows 64-bit uses MSHTA.EXE 32-bit. The registry has a separate branches for 64-bit and 32-bit apps, thus WMI can't find the registry value you are looking for.
Save the code below to e. g. C:\test\tmp.hta, try to launch it from explorer by double-click (32-bit by default) - you will get null, and then launch via Run dialog (Win+R) with path: %windir%\system32\mshta.exe "C:\test\tmp.hta" (64-bit), the result will be your username.
<html>
<head>
<script language="vbscript">
Sub window_onload()
Const HKEY_LOCAL_MACHINE = &H80000002
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Authentication\LogonUI"
strValueName = "LastLoggedOnUser"
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
document.body.innerText = strValue
End Sub
</script>
</head>
<body>
</body>
</html>
Note that many other stuff within scripts depends on application architecture, e. g. number of ActiveX are available only in 32-bit version, so they should be launched via %windir%\SysWOW64\ (Windows 32-bit on Windows 64-bit subsystem).
Use Msgbox function instead of Wscript.Echo method. HTAs use the Internet Explorer Scripting Object Model which does not contain Wscript object (this belongs to Windows Script Host Object Model).
Read HTA: Why Can’t I Use Wscript.Echo?:
You might have noticed that when it came time to report back the
operating system version we used the VBScript Msgbox function rather
than the more common Wscript.Echo. Why didn’t we use Wscript.Echo?
Here’s why:
As it turns out the various Wscript methods - Wscript.Echo,
Wscript.Sleep, Wscript.Quit, etc. - are designed solely to run under
the Windows Script Host environment. When we’re working in an HTA
we’re not running under WSH; instead we’re running under the MSHTA
process. Because of that the Wscript methods are not available to us
(nor can we create them). Consequently we need to find workarounds for
each method, and Msgbox is a perfectly adequate replacement for
Wscript.Echo. (We’ll talk about workarounds for other methods - such
as Wscript.Sleep - when we get to them.)
The moral of the story: Don’t bother with Wscript.Echo; it won’t work.
Edit: with Wscript.Echo TypeName(strValue) & vbNewLine & VarType(strValue):
==> C:\Windows\System32\cscript.exe D:\VB_scripts\SO\33505295.vbs
String
8
==> C:\Windows\SysWOW64\cscript.exe D:\VB_scripts\SO\33505295.vbs
Null
1
Tried in a simple HTA which gives the same (different) result
==> C:\Windows\System32\mshta.exe 33505295.hta
versus
==> C:\Windows\SysWOW64\mshta.exe 33505295.hta
Conclusion. Check HTA file type association. For instance, ftype htafile in my Windows 8 (64bit) returns (surprisingly?) the same value which causes wrong behaviour on double click:
==> assoc .hta
.hta=htafile
==> ftype htafile
htafile=C:\Windows\SysWOW64\mshta.exe "%1" {1E460BD7-F1C3-4B2E-88BF-4E770A288AF5}%U{1E460BD7-F1C3-4B2E-88BF-4E770A288AF5} %*
I have had the same challenge a few weeks ago.
The following code provided me the possibility to see who is currently logged onto a remote computer.
I hope this can help you.
Sub ActionGetCurrentUser(strCPU) 'strCPU is the computername
set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strCPU & "\root\cimv2")
set Items = objWMI.ExecQuery("Select * From Win32_ComputerSystem")
For Each obj in Items
OutStr = right(obj.username,9)
Next
Resultstring = "Logged in User is: " & OutStr
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strTarget = "LDAP://" & strDNSDomain
' ---------------- Write the User's account & password to a variable -------------------
strCurrentuser = Currentuser.value
strPassword = PasswordArea.value
' ---------------- Connect to Ad Provider ----------------
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Properties("User ID") = strCurrentUser ' pass credentials - if you omit this, the search is performed....
objConnection.Properties("Password") = strPassword ' ... with the current credentials
objConnection.Properties("Encrypt Password") = True ' only needed if you set "User ID" and "Password"
objConnection.Open "Active Directory Provider"
Set objCmd = CreateObject("ADODB.Command")
Set objCmd.ActiveConnection = objConnection
objCmd.CommandText = "SELECT DisplayName FROM '" & strTarget & "' WHERE extensionAttribute11 = '" & OutStr & "'"
Const ADS_SCOPE_SUBTREE = 2
objCmd.Properties("Page Size") = 100
objCmd.Properties("Timeout") = 30
objCmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCmd.Properties("Cache Results") = False
Set objRecordSet = objCmd.Execute
If objRecordset.Recordcount = 0 then ' If no user is found then the recordcount will be 0
msgbox "No user is logged on"
Resultstring = ""
Set objCmd = Nothing
Set objRootDSE = Nothing
Set objRecordSet = Nothing
Set objWMI = Nothing
Set Items = Nothing
exit sub
End if
Set objRecordSet = objCmd.Execute
objRecordSet.MoveFirst
Resultstring = Resultstring & vbcrlf & "Name: " & objRecordset.fields("DisplayName")
Msgbox Resultstring
Resultstring = ""
Set objCmd = Nothing
Set objRootDSE = Nothing
Set objRecordSet = Nothing
Set objWMI = Nothing
Set Items = Nothing
End Sub
Set objDomain = GetObject("WinNT://abc.local")
For each objDomainItem in objDomain
if objDomainItem.Class = "User" then
'WScript.echo "Name: " & objDomainItem.Name + " : Full Name: " + objDomainItem.FullName
Set objUser = Nothing
err.clear
Set objUser = GetObject("LDAP://cn=" & objDomainItem.FullName & ",OU=IS, OU=Users, OU=ABC Company, DC=ABC, dc=local")
if err.number = 0 then
wscript.echo "distinguishedName: " & objUser.distinguishedName
end if
end if
Next
Right now, this works fine to list all users in the IS department (OU=IS). But when I take out "OU=IS" to list all users in all departments, it returns nothing; no user objects at all. The only way it will return the user object for the given fullName is if I also specify the OU that that user is contained in; but I do not have the OU to supply it.
Our AD structure is
ABC Company --> Users --> IS
ABC Company --> Users --> FINANCE
ABC Company --> Users --> Management
ABC Company --> Users --> Flight Operations
etc etc etc
I want to use the code above to enumerate all users from the "Users" level, down through ALL departments, but again, as soon as I remove "OU=IS", it returns nothing.
Any help?
Do a query with scope Subtree using an ADODB.Connection and an ADODB.Command object:
base = "<LDAP://OU=Users,OU=ABC Company,DC=ABC,DC=local>"
fltr = "(&(objectClass=user)(objectCategory=Person))"
attr = "distinguishedName,sAMAccountName"
scope = "subtree"
Set cn = CreateObject("ADODB.Connection")
cn.Provider = "ADsDSOObject"
cn.Open "Active Directory Provider"
Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = cn
cmd.CommandText = base & ";" & fltr & ";" & attr & ";" & scope
Set rs = cmd.Execute
Do Until rs.EOF
WScript.Echo rs.Fields("distinguishedName").Value
WScript.Echo rs.Fields("sAMAccountName").Value
rs.MoveNext
Loop
Add other attributes to attr as required (the variable contains a list of attribute names as a comma-separated string).
Since these queries require the same boilerplate code every time, I got fed up with writing it over and over again some time ago and wrapped it in a custom class (ADQuery) to simplify its usage:
'<-- paste or include class code here
Set qry = New ADQuery
qry.SearchBase = "OU=Users,OU=ABC Company,DC=ABC,DC=local"
qry.Attributes = Array("distinguishedName", "sAMAccountName")
Set rs = qry.Execute
Do Until rs.EOF
WScript.Echo rs.Fields("distinguishedName").Value
WScript.Echo rs.Fields("sAMAccountName").Value
rs.MoveNext
Loop