Need VBScript to list disabled accounts - vbscript

The following script check local computers for inactive (90 days or more) accounts and disables them. The script works fine, but it lists all the disabled accounts every time is executed. I only need it to list the accounts that have been disabled the day is was executed.
Option Explicit
Dim objNetwork, strComputer, objComputer, objUser, dtmLast, objGroup, ObjGroupDict
Dim FSO, OutPutFile
Set FSO = CreateObject("Scripting.FileSystemObject")
'1 = reading, 2 = writing, and 8 = appending. The third parameter is a
'boolean true means a new file can be created if it doesn't exist. False
'means a new file cannot be created.
Set OutPutFile = FSO.OpenTextFile("C:\Test\Result.log", 8, True)
'Bind to the local computer.
Set objNetwork = CreateObject("WScript.Network")
strComputer = objNetwork.ComputerName
Set objComputer = GetObject("WinNT://" & strComputer & ",computer")
'Enumerate all users.
objComputer.Filter = Array("user")
For Each objUser In objComputer
Set ObjGroupDict = CreateMemberOfObject(objUser)
If ((Left(objUser.Name,3) <> "au_") And (CBool(ObjGroupDict.Exists("Administrators") = False))) Then
'Trap error if user never logged in.
On Error Resume Next
dtmLast = objUser.lastLogin
If (Err.Number <> 0) Then
dtmLast = #1/1/1970#
End If
On Error GoTo 0
'Check if last logon was more than 90 days in the past.
If (DateDiff("d", dtmLast, Now()) > 90) Then
'Disable the user.
objUser.AccountDisabled = True
objUser.SetInfo
OutPutFile.WriteLine(Now & " " & strComputer & " " & Wscript.ScriptName & " " & objUser.Name & " " & "Disabled")
'MsgBox objUser.Name
Set FSO = Nothing
End If
End If
Next
Function CreateMemberOfObject(objUser)
'Given a domain name and username, returns a Dictionary
'object of groups to which the user is a member of.
'Inputs: objUser - User Object
Set CreateMemberOfObject = CreateObject("Scripting.Dictionary")
CreateMemberOfObject.CompareMode = vbTextCompare
Dim objGroup
For Each objGroup In objUser.Groups
CreateMemberOfObject.Add objGroup.Name, "-"
Next
End Function

You're disabling all accounts whose last login was more than 90 days ago, even if the account already is disabled. Add a condition that matches only accounts that are not disabled, and the code will do what you want:
If DateDiff("d", dtmLast, Now) > 90 And Not objUser.AccountDisabled Then
...
End If

Related

VBS to write multiple lines in textfile

I have a vbscript that checks for all users and checks for its last login time.
i open a file to write inside the file. However , i seem to have an issue where the it is writing only the last name it checks instead of all the names.
Result in the text should be :
user1
user2
user3
user4
However , this is my current result :
user4
How do i go about this?
I do apologize as i am mainly in C# and VBS is very new to me.
Option Explicit
Dim strComputer, objComputer, objUser, FSO, File
Const ForWriting = 2
strComputer = "."
Set objComputer = GetObject("WinNT://" & strComputer)
objComputer.Filter = Array("user")
For Each objUser In objComputer
Set FSO = CreateObject("Scripting.FileSystemObject")
Set File = FSO.OpenTextFile("C:\Users\sgbvx\Desktop\test\test.txt",ForWriting, True)
On Error Resume Next
Wscript.Echo objUser.Name & ", " & objUser.LastLogin
File.WriteLine objUser.Name
File.Write objUser.LastLogin
File.Close
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo objUser.Name & ", "
End If
On Error GoTo 0
Next
File.Close
So apparently my code has some arrangement issue that created a lot errors.
Here's my answer and an updated code for the above :
Option Explicit
Dim strComputer, objComputer, objUser, FSO, File
Const ForWriting = 2
strComputer = "."
Set objComputer = GetObject("WinNT://" & strComputer)
objComputer.Filter = Array("user")
Set FSO = CreateObject("Scripting.FileSystemObject")
//You may change the file name or directory//
Set File = FSO.OpenTextFile("C:\temp\test.txt",ForWriting, True)
//Start of ForEach loop , previously Set FSO and Set File was in this loop//
For Each objUser In objComputer
On Error Resume Next
//Writes Username and LastLogin detail//
File.Write objUser.Name & ", " & objUser.LastLogin
File.WriteLine
If (Err.Number <> 0) Then
On Error GoTo 0
//Writes only Username if LastLogin was not detected//
File.Write objUser.Name & ", "
File.WriteLine
End If
On Error GoTo 0
Next
File.Close

VBScript only copies empty (265K) PST from Network folder to Network Folder

Currently all users are mapped to their Home Z:\ drives. We have created (Network Share) P:\ drives for users to use for PST files. I am tasked with copying attached PSTs(whether they exist on the local C:\ drive or the user's personal share Z:\) to the new P:\, and remap their outlook. There are 1800 Users and attaching this script to a GPO is the logical way.
This script works successfully for the PST files on C:\. The issue I am running into, is that it only copies an empty "shell" version of the PST file (with the same name) that is attached from the user's Z:\ drive. An empty PST file (265K) is copied over to the P: drive. Below is the Code that I am running. Any assistance will be greatly Appreciated.
Option Explicit
Const OverwriteExisting = True
'get username, will use later
dim objNetwork, username, LogFolder, LogFile
Dim cnt : cnt = 0
Dim counter : counter = 0
Set objNetwork = CreateObject("WScript.Network")
username = objNetwork.UserName
username = LCase(username)
LogFolder = "c:\ProgramData\Logs\" & username
LogFile = LogFolder & "\" & "pst.txt"
'network path to write pst files to
Dim strNetworkPath : strNetworkPath = "\\NetworkShare\PST\" & username
If Not Right(strNetworkPath,1) = "\" Then strNetworkPath = strNetworkPath &
"\" End If
'initiate variables and instantiate objects
Dim objOutlook, objNS, objFolder, objFSO, objFName, objTextFile, pstFolder,
pstFiles, pstName, strPath, objShell
Set objFSO = CreateObject("Scripting.FileSystemObject")
'only run once per user, quit if log file already created from previous run
If objFSO.FileExists(LogFile) Then
MsgBox "Script has already been run, Exiting"
WScript.Quit()
End If
Set objTextFile = objFSO.CreateTextFile("c:\ProgramData\Logs\" & username &
"\pst.txt" , True)
Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
Set objShell = WScript.CreateObject("Wscript.Shell")
Dim count : count = -1
'Enumerate PST files and build arrays
objTextFile.Write("Enumerating PST files" & vbCrLf)
For Each objFolder in objNS.Folders
If GetPSTPath(objFolder.StoreID) <> "" Then
count = count + 1
pstFiles = GetPSTPath(objFolder.StoreID)
pstName = objFolder.Name
pstFolder = objFolder
objTextFile.Write(count & " " & pstFiles & vbCrLf)
ReDim Preserve arrNames(count)
arrNames(count) = pstName
ReDim Preserve arrPaths(count)
arrPaths(count) = pstFiles
End If
Next
'quits if no pst files were found
If count < 0 Then
MsgBox "No PST Files Found."
Wscript.Quit()
End If
MsgBox "PST Migration Starting. Outlook will close and re-open, Please be
patient."
For Each pstName in arrNames
set objFolder = objNS.Folders.Item(pstName)
objNS.RemoveStore objFolder
Next
set objFolder = Nothing
'closes the outlook session
objOutlook.Session.Logoff
objOutlook.Quit
Set objOutlook = Nothing
Set objNS = Nothing
objTextFile.Write("moving them" & vbCrLf)
' copies the found pst files to the new location
Dim pstPath
For Each pstPath In arrPaths
On Error Resume Next
objTextFile.Write(pstPath & vbCrLf)
pstPath.Copy(strNetworkPath)
objFSO.Copyfile pstPath, strNetworkPath
If Err.Number <> 0 Then
Wscript.sleep 5000
objFSO.Copyfile pstPath, strNetworkPath
End If
Err.Clear
On Error GoTo 0
Next
Set objFSO = Nothing
'sleep shouldn't be necessary, but was having issues believed to be related
to latency
wscript.sleep 5000
'Re-open outlook
Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
'Re-map Outlook folders
For Each pstPath In arrPaths
objTextFile.Write("Remapping " & pstPath & " to " & strNetworkPath &
Mid(pstPath, InStrRev(pstPath, "\") + 1) & vbCrLf)
objNS.AddStore strNetworkPath & Mid(pstPath, InStrRev(pstPath, "\") + 1)
Next
count = -1
For Each objFolder In objNS.Folders
If GetPSTPath(objFolder.StoreID) <> "" Then
count = count + 1
objTextFile.Write("Renaming " & GetPSTPath(objFolder.StoreID) & " to " &
arrNames(count) & vbCrLf)
objFolder.Name = arrNames(count)
End If
Next
objOutlook.Session.Logoff
objOutlook.Quit
objTextFile.Write("Closing Outlook instance and unmapping obj references...")
Set objFolder = Nothing
Set objTextFile = Nothing
Set objOutlook = Nothing
Set objNS = Nothing
'wscript.echo "PST Migration and Remapping is Complete"
MsgBox "PST Migration and Remapping is Complete"
wscript.Quit
Private Function GetPSTPath(byVal input)
'Will return the path of all PST files
Dim i, strSubString, strPath
For i = 1 To Len(input) Step 2
strSubString = Mid(input,i,2)
If Not strSubString = "00" Then
strPath = strPath & ChrW("&H" & strSubString)
End If
Next
Select Case True
Case InStr(strPath,":\") > 0
GetPSTPath = Mid(strPath,InStr(strPath,":\")-1)
Case InStr(strPath,"\\") > 0
GetPSTPath = Mid(strPath,InStr(strPath,"\\"))
End Select
End Function

Active Directory PSO fine grained passwords msDS-MaximumPasswordAge

Looking how to create a vbscript to pull the maximum number of days a PSO policy has set. It comes back as a value of ... and I do not know how to get the real value that was set.
This is what I have so far:
Option Explicit
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Dim strFilePath, objFSO, objFile, adoConnection, adoCommand, objCDOConf
Dim objRootDSE, strDNSDomain, strFilter, strQuery, adoRecordset, objMaxPwdAge
Dim strDN, objShell, lngBiasKey, lngBias, blnPwdExpire, strDept, strAdd
Dim objDate, dtmPwdLastSet, lngFlag, k, address, objAdd, objMessage
' Check for required arguments.
If (Wscript.Arguments.Count < 1) Then
Wscript.Echo "Arguments <FileName> required. For example:" & vbCrLf _
& "cscript PwdLastChanged.vbs c:\MyFolder\UserList.txt"
Wscript.Quit(0)
End If
strFilePath = Wscript.Arguments(0)
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Open the file for write access.
On Error Resume Next
Set objFile = objFSO.OpenTextFile(strFilePath, 2, True, 0)
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "File " & strFilePath & " cannot be opened"
Wscript.Quit(1)
End If
On Error GoTo 0
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
& "TimeZoneInformation\ActiveTimeBias")
If (UCase(TypeName(lngBiasKey)) = "LONG") Then
lngBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If
' Use ADO to search the domain for all users.
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOOBject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Determine the DNS domain from the RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
' Filter to retrieve all user objects.
strFilter = "(&(objectClass=msDS-PasswordSettings))"
' Filter to retrieve all computer objects.
strQuery = "<LDAP://CN=PSO-Information Systems,CN=Password Settings Container,CN=System,DC=yrmc,DC=org>;" _
& ";cn,msDS-LockoutDuration,msDS-MaximumPasswordAge,msDS-
PasswordSettingsPrecedence;subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
objFile.WriteLine adoRecordset.Fields("cn").Value
adoRecordset.MoveNext
Loop
adoRecordset.Close
I can get a value for cn and even msDS-PasswordSettingsPrecedence but not for msDS-MaximumPasswordAge. Any help would be appreciated.
This is at best a partial answer but I did some searching and I believe you will need one or more of the following:
DSGet/DSQuery
LDIFDE to manage PSO's.
Quest's "Free PowerShell Commands for Active Directory"
Using Quest's free tools, you might find this link handy
Put square brackets around our Active Directory attribute name:
See the blog post "How can I retrieve the value of an active directory attribute that has a hyphen in its name" for more.
you have to find UsersPSO location in your AD like that
domainLookupString = ""CN=UsersPSO,CN=Password Settings Container,CN=System,DC=COMPAY,DC=ORG";
then run the ldap query
ldapFilterString = "(&(objectClass=msDS-PasswordSettings))";
at the end, get the ldap attribute with the Maximum Password Age of the current PSO policy
"msDS-MaximumPasswordAge"

How can I limit the number of instances of an application being run in a single Windows session?

Some time ago on I asked about limiting the number of instances of Excel being run concurrently in Windows.
Thanks to the help I got on StackOverflow.com I was able to put together the following function that shuts down any instance of Excel that is launched if there is already another instance of Excel running.
Private Function KillDuplicateProcesses() As Boolean
Dim objWMIService As Object
Dim colItems As Variant
Dim objItem As Object
Dim intCount As Integer
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.InstancesOf("Win32_Process")
For Each objItem In colItems
intCount = intCount + Abs(LCase(objItem.Name) = "excel.exe")
If intCount > 1 Then
MsgBox "Excel is already running." & vbCrLf & vbCrLf & _
"To open a file use " & IIf(Application.Version >= 12, "Office Button", "File") & " > Open (Ctrl + O).", vbCritical
KillDuplicateProcesses = True
Application.Quit
Exit For
End If
Next
End Function
The problem is that if a user is logged onto a remote desktop session as an administrator, that user account can see all of the other users and the processes that they have running. So if another user is logged onto the same machine and is running Excel, the function counts those instances as well and shuts down the instance of Excel that has just been launched.
I need to limit the scope of that function to the currently running session. According to MSDN documentation there is a class property called SessionID. Can I use that property and compare it against the current session's ID to limit what the function counts, or is there a better way to do it?
Any suggestions would be greatly appreciated.
Thanks!
Below is the solution code per Tim's suggestion. Note I am comparing the GetOwner properties against Environ UserName and UserDomain. Environ is considered unreliable because it can be changed by the user.
Private Function KillDuplicateProcesses() As Boolean
Dim objWMIService As Object
Dim colItems As Variant
Dim objItem As Object
Dim intCount As Integer
Dim strProcessUser As Variant
Dim strProcessDomain As Variant
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'excel.exe'")
If colItems.Count > 1 Then
For Each objItem In colItems
strProcessUser = ""
strProcessDomain = ""
objItem.GetOwner strProcessUser, strProcessDomain
If IsNull(strProcessUser) Then strProcessUser = ""
If IsNull(strProcessDomain) Then strProcessDomain = ""
intCount = intCount + Abs(strProcessUser = Environ("UserName") _
And strProcessDomain = Environ("UserDomain"))
If intCount > 1 Then
MsgBox "You cannot run more than one instance of Excel while iTools is activated." & vbCrLf & vbCrLf & _
"To open a file use " & IIf(Application.Version >= 12, "Office Button", "File") & " > Open (Ctrl + O).", vbCritical
KillDuplicateProcesses = True
Application.Quit
Exit For
End If
Next
End If
End Function
'get process owner username and domain
Dim strUser, strDomain
objItem.getOwner strUser, strDomain
MsgBox strUser & ", " & strDomain

VBScript: way to check why the script stopped?

I have this VBScript which runs however, while it is processing, it will randomly stop and require a user to hit the spacebar for it to display the rest of its ongoing output.
How do I figure out why this is happening?
Here is a copy of the script:
'On Error Resume Next
Dim arrFolders()
intSize = 0
Function StampNow()
Dim Hr, Mn, Yr, Mon, Dy, Date1
Date1=Now()
Hr=DatePart("h",Date1)
Mn=DatePart("n",Date1)
Yr = DatePart("yyyy",Date1)
Mon = DatePart("m",Date1)
Dy = DatePart("d",Date1)
StampNow = Yr & "-" & Mon & "-" & Dy
end function
'Output log info.
Function OutputToLog (strToAdd)
Dim strDirectory,strFile,strText, objFile,objFolder,objTextFile,objFSO
strDirectory = "c:\log"
strFile = "\dpadmin_copy2run-"& StampNow & ".bat"
'strText = "dpadmin_copy2"
strText = strToAdd
' Create the File System Object.
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the strDirectory folder exists.
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
'WScript.Echo "Just created " & strDirectory
End If
If objFSO.FileExists(strDirectory & strFile) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
'Wscript.Echo "Just created " & strDirectory & strFile
End If
set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
' Writes strText every time you run this VBScript.
objTextFile.WriteLine(strText)
objTextFile.Close
End Function
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
strFolderName = "D:\1\production\Openjobs"
Set colSubfolders = objWMIService.ExecQuery _
("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
& "Where AssocClass = Win32_Subdirectory " _
& "ResultRole = PartComponent")
dim diffindates
'Init vars for regex.
Dim retVal, retVal2
Dim Lastprop
Dim objRegExpr 'regex variable
Set objRegExpr = New regexp
Set objRegExprX31 = New regexp
objRegExpr.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9][A-Z][A-Z][A-Z]"
objRegExprX31.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9]X31"
objRegExpr.Global = True
objRegExprX31.Global = True
objRegExpr.IgnoreCase = True
objRegExprX31.IgnoreCase = True
'Variables for getting last accessed property.
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
'Current time vars.
Dim currenttime
currenttime = Now()
ParentFolder = "D:\1\Production\Openjobs\ClosedJobs"
For Each objFolder in colSubfolders
intSize = intSize + 1
retVal = objRegExpr.Test(objFolder.Name)
retVal2 = objRegExprX31.Test(objFolder.Name)
if (retVal OR retVal2 ) then
'set filename to array
strFolderName = objFolder.Name
'Get last modified date.
Set f = fs.GetFolder(objFolder.Name)
Lastprop = f.DateLastModified
'MsgBox(Lastprop)
if ( DateDiff("m", f.DateLastModified, Now()) > 4) then
diffindates = DateDiff("m", f.DateLastModified, Now())
Set objShell = CreateObject("Shell.Application")
Set objCopyFolder = objShell.NameSpace(ParentFolder)
OutputToLog("rem " & f.DateLastModified & ":" & objFolder.Name )
outputtolog("move /Y """ & objFolder.Name & """ " & ParentFolder)
wscript.echo(diffindates & ":" & objFolder.Name & vbCr)
end if
end if
Next
Update
It stops at the line:
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
with the error Microsoft VBScript runtime error: Permission denied
I'm a little confusd by this. The logfile was only 356kb
I was able to run your script several times without it pausing for input. Run your script with the //X flag to start it in the debugger:
>cscript //nologo //X dpadmin_copy2.vbs"
You should be able to then step through the code.
You can also start putting in wscript.echo trace statements everywhere and see if you can narrow down what it's waiting on.
One thing that's gotten me in the past; If your command console is in QuickEdit mode and you accidentally click anywhere in the console window, the console will hang while it waits for you to press a key.
Well the first step is to remove any global On Error Resume Next statements. Better feedback would come if we could see the script.
You usually get an Permission denied when trying to write to a text file when the text file already has an open handle from some other process or because you have previously opened a handle earlier in you code which you have not closed. I haven't tried this but I don't know why this wouldn't work, you can look at using Handle from Sysinternals (Microsoft) to tell you what process has the open handle for the file. Please see here for a further reference of how to use Handle: http://www.orcsweb.com/blog/post/Closing-open-file-handles.aspx You could also write a second script which runs in a loop to monitor the main script. The second script can verify the first script by doing a WMI Process query which returns only processes that match a defined command line. The second script could then restart the main it stops, alert you, log a file, launch a handle search, etc.

Resources