Monitor Specific User Logons/Logoffs
Hi,
Looking for a script that will log (into a text file/csv - no real
preference), when specific users login and log off the system.
I've seena handful of scripts, but can't seem to find anything that fits my
requirements.
Many thanks in advance to anyone who responds :o)
Kind Regards Tag: Changing text from upper case to title case Tag: 211468
Help deleting a network share
Hi All,
Can anyone help me. I have some code to disable a network account and
delete the network share for the users home folder. The script does
not error, however the network share still exists and is not deleted.
The servername and sharename is extracted from the home directory
field in AD and then split to give the servername and sharename. I am
running the script from a different server to the one which the share
resides on.
Anyone have any suggestions why this does not work? I also have the
same problem trying to delete a remote folder, but hope that the
solution to this will also be the solution to that problem. Here is my
code for the deletion of the share.
strComputer = servername
Set objWMIService = GetObject("winmgmts:" &
"{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colShares = objWMIService.ExecQuery ("Select * from Win32_Share
Where Name = 'sharename'")
For Each objShare in colShares
objShare.Delete
Next
Many Thanks in Advance Tag: Changing text from upper case to title case Tag: 211467
fax script
hi,
how to do send fax script with fax e-mail delivery notification. here is
code but someting is missing. fax server not sending mail notification. can
anyboyd help me.
thanks,
set srv = CreateObject("FaxServer.FaxServer")
srv.Connect "."
set doc = srv.CreateDocument("c:\temp\faxdata.txt")
doc.FaxNumber = "4424553"
doc.EmailAddress = "koray@korayonur.net"
doc.send Tag: Changing text from upper case to title case Tag: 211466
dsolefile.propertyreader - add new custom properties
Hi....I'm trying to write a script that tests for a custom property of
a document and, if it does not exist, adds it to the document....
I actually managed to do it, but there seems to be a problem. When I
open a document that contains the property, no problem....it
works....it just reads the property and set its relative html control.
When the property does not exist, I try to add it like in the code
below, but something goes wrong and the browser seems to crash and
close before I can do anything. What is strange is that the property
is actually added and written correctly to the file, but the browser
crashes without giving me any error message.
Does anyone have any idea?
Thank You
Here's my code:
------------------------------------------------------------------------
Function PropertyExists(document,propertyname)
dim Materia,settore
ON ERROR RESUME NEXT
Materia = document.CustomProperties("materia")
If err Then
MsgBox "Errore! " & err.description
PropertyExists = False
else
PropertyExists = True
End If
End Function
Sub CheckDoc_SelezNuovePropr(PathFile)
rendeFileModificabile(PathFile)
Set objFilePropReader = CreateObject("DSOleFile.PropertyReader")
Set objDocProp = objFilePropReader.GetDocumentProperties(PathFile)
Dim sMateria,sArgomento,sSegmenti,sRuoli
Dim iTipoNumber,iTipoString
sMateria = "22"
iTipoNumber = 2
iTipoString = 1
if PropertyExists(objDocProp,"materia") then
document.all.item("DDLMateria").value =
objDocProp.CustomProperties("materia").Value
call document.all.item("DDLMateria").onchange()
document.all.item("DDLArgomento").value =
objDocProp.CustomProperties("argomento").Value
sSegmenti = objDocProp.CustomProperties("segmenti").Value
sRuoli = objDocProp.CustomProperties("ruoli").Value
SetCheckBoxList "FormContesto", "cLstSegMercato", sSegmenti
SetCheckBoxList "FormContesto", "cLstRuoliInteressati", sRuoli
else
on error resume next
objDocProp.CustomProperties.Add "materia",
castValoreAttributoCustom(sMateria, iTipoNumber)
if err.number>0 then
msgbox err.Description
end if
end if
Set objDocProp = Nothing
Set objFilePropReader = Nothing
End Sub
------------------------------------------------------------------------ Tag: Changing text from upper case to title case Tag: 211463
Remote registry read
Hi there,
I need some help please, I managed to find this script in the
newsgroup on bulk registry read of remote machines but I can't seem to
get it to work.
I've created all the required text files and reformatted the tet wrap,
but when it executes it gives me an error regarding the "Left" command
within the "'Function to parse registry file into a branch, subkey,
and items " function.
Can anyone give me some assistance please, I need to script to scan
our servers to confirm what service pack they have for Win2k3 SP2
deployment.
'*********************
' GLOBALS
'*********************
Dim aComputers(), aRegistryPaths()
Dim aBranch(), aSubkey(), aItem()
Dim sMachine, iComputers, iRegistry, iCount
Const sPath = "c:\temp\ServerList.txt"
Const sRegistryFile = "c:\temp\Registry.txt"
' Get list of computer names
iComputers = ReadFileToArray(sPath, aComputers)
' Get list of registry keys
iRegistry = ReadFileToArray(sRegistryFile, aRegistryPaths)
'WriteArrayToScreen(aComputers)
'WriteArrayToScreen(aRegistryPaths)
' Hard work starts here....
' For each computer
For iComp = 0 to iComputers-1
' WScript.Echo chr(13)
' WScript.Echo iComp & ". *** " & UCase(aComputers(iComp)) & " ***"
ParseFile sRegistryFile, iRegistry, aBranch, aSubkey, aItem
For iCount = 0 to iRegistry-1
' WScript.Echo
' WScript.Echo iCount & ". COMPUTER = " & aComputers(iComp)
' WScript.Echo " BRANCH = " & aBranch(iCount)
' WScript.Echo " SUBKEY = " & aSubkey(iCount)
' WScript.Echo " ITEMS = " & aItem(iCount)
' WScript.Echo
GetRegistryValues aComputers(iComp), aBranch(iCount),
aSubKey(iCount),aItem(iCount)
Next
Next
'************************************************************************
'Function to parse registry file into a branch, subkey, and items
'************************************************************************
Function ParseFile(sFile, iNumOfRecordsInFile, ByRef aBranch, ByRef
aSubkey,ByRef aItems)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim sLine, i, j, sBranch, sSubkey, sItem
Dim aBreakdown
Redim aBranch(iNumOfRecordsInFile),
aSubkey(iNumOfRecordsInFile),aItem(iNumOfRecordsInFile)
i = 0
j = 0
Set objFSO = CreateObject("Scripting.FileSystemObject")
WScript.Echo chr(13)
If objFSO.FileExists(sFile) Then
Set objFile = objFSO.OpenTextFile(sFile, ForReading)
' WScript.Echo "BRANCH SUBKEY ITEMS"
' WScript.Echo "------ ------ -----"
Do Until objFile.AtEndOfStream
sLine = objFile.ReadLine
aBreakdown = Split(sLine, "\")
aBranch(i) = aBreakdown(0)
For j = LBound(aBreakdown)+1 to UBound(aBreakdown)-1
aSubkey(i) = aSubkey(i) + aBreakdown(j) + "\"
Next
aSubkey(i) = Left(aSubkey(i), Len(aSubkey(i))-1)
If aBreakdown(UBound(aBreakdown)) = "*" Then
aItem(i) = ""
Else
aItem(i) = aBreakdown(UBound(aBreakdown))
End If
' WSCript.Echo aBranch(i) & vbTab & Left(aSubkey(i),30) & vbTab &
aItem(i)
i = i + 1
Loop
objFile.Close
Else
Wscript.Echo "File '" & sPath & "' does not exist"
WScript.Quit(1)
End If
End Function
'************************************************************************
'User-defined function to read computer names into array
'************************************************************************
Function ReadFileToArray(sFile, ByRef aArray)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
i = 0
i = CountLinesInFile(sFile)
Redim aArray(i)
i = 0
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(sPath) Then
Set objFile = objFSO.OpenTextFile(sFile, ForReading)
Do Until objFile.AtEndOfStream
aArray(i) = objFile.ReadLine
i = i + 1
Loop
'Wscript.Echo "File '" & sFile & "' exists. Found " & i & "
records"
objFile.Close
Else
Wscript.Echo "File '" & sFile & "' does not exist"
WScript.Quit(1)
End If
ReadFileToArray = i
End Function
'************************************************************************
'User-defined function to count lines in file
'************************************************************************
Function CountLinesInFile(sPath)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim iLineCount
LineCount = 0
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(sPath) Then
Set objFile = objFSO.OpenTextFile(sPath, ForReading)
Do Until objFile.AtEndOfStream
objFile.ReadLine
iLineCount = iLineCount + 1
Loop
' Wscript.Echo "File '" & sPath & "' exists. Counted " & iLineCount
& " lines"
objFile.Close
Else
Wscript.Echo "File '" & sPath & "' does not exist"
WScript.Quit(1)
End If
CountLinesInFile = iLineCount
End Function
'************************************************************************
'User-defined function to read computer names into array
'************************************************************************
Function WriteArrayToScreen(ByRef aArray)
For i = LBound(aArray) To UBound(aArray)
WScript.Echo i & ")" & aArray(i)
Next
End Function
'************************************************************************
'User-defined function to get registry values
'************************************************************************
Function GetRegistryValues(sMachine, sBranch, sSubKey, sNames)
Dim oLoc, oSvc, oReg, sMsg, uTemp, sTemp
Dim i, j, iBranch
Dim sValues()
' Dim sNames()
Dim aTypes()
Dim sRegTypes
sRegTypes = Array(_
" ", _
"REG_SZ ", _
"REG_EXPAND_SZ ", _
"REG_BINARY ", _
"REG_DWORD ", _
"REG_DWORD_BIG_ENDIAN ", _
"REG_LINK ", _
"REG_MULTI_SZ ", _
"REG_RESOURCE_LIST ", _
"REG_FULL_RESOURCE_DESCRIPTOR ", _
"REG_RESOURCE_REQUIREMENTS_LIST", _
"REG_QWORD ")
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Set oLoc = CreateObject("WbemScripting.SWbemLocator")
Set oSvc = oLoc.ConnectServer(sMachine, "root\default")
'passes the VBScript Err object to the user-defined subroutine to
check the return code.
Call CheckResult("ConnectServer", err)
'Obtains a registry provider object
Set oReg = oSvc.Get("StdRegProv")
Call CheckResult("Get StdRegProv", err)
Select Case sBranch
Case "HKEY_CLASSES_ROOT"
iBranch = &H80000000
Case "HKEY_CURRENT_USER"
iBranch = &H80000001
Case "HKEY_LOCAL_MACHINE"
iBranch = &H80000002
Case "HKEY_USERS"
iBranch = &H80000003
End Select
' WScript.Echo
' WScript.Echo "Connected to " & sMachine & " OK!"
' WScript.Echo
' WScript.Echo "**DEBUG**"
' WScript.Echo "MACHINE = " & sMachine
' WScript.Echo "BRANCH = " & sBranch & " (" & iBranch & ")"
' WScript.Echo "SUBKEY = " & sSubkey
' WScript.Echo "ITEMS = " & sNames
' WScript.Echo "**DEBUG**"
' WScript.Echo
' if it's a single key then just get that
If sNames <> "" Then
' i know this will only get dword's, for me that was enough :-/
E = oReg.GetDWORDValue(iBranch, sSubKey, sNames, sValues)
If (E = 0) And (Err.Number = 0) Then
sMsg = "Machine: " & Padding(sMachine,20) & vbTab & "Name: " &
Padding(sNames,20) & vbTab & "Value: " & sValues
Else
sMsg = "Machine: " & Padding(sMachine,20) & vbTab & "NO RECORDS -
DOES THE KEY EXIST?"
End If
WScript.Echo sMsg
Else 'get the whole subkey
WScript.Echo chr(13)
WScript.Echo iComp & ". *** " & UCase(sMachine) & " ***"
E = oReg.EnumValues(iBranch, sSubkey, sNames, aTypes)
Call CheckResult("EnumValues", err)
If (E = 0) And (Err.Number = 0) Then
i = UBound(aTypes)
Redim sValues(i)
'List the names and types in the registry path
For i = LBound(aTypes) To UBound(aTypes)
sTemp = ""
sMsg = ""
Select Case aTypes(i)
Case 1 ' REG_SZ
' Gets the string data value of a named value
E = oReg.GetStringValue(iBranch, sSubKey, sNames(i), sValues(i))
' WScript.Echo i & ") Got Here: GetStringValue " & sValues(i)
Case 2 ' REG_EXPAND_SZ
' Gets the expanded string data value of a named value.
E = oReg.GetExpandedStringValue(iBranch, sSubKey, sNames(i),
sValues(i))
' WScript.Echo i & ") Got Here: GetExpandedStringValue " &
sValues(i)
Case 3 ' REG_BINARY
' Gets the binary data value of a named value.
E = oReg.GetBinaryValue(iBranch, sSubKey, sNames(i), uTemp)
For j = LBound(uTemp) To UBound(uTemp)
sTemp = sTemp & uTemp(j) & " "
' If j = UBound(uTemp) Then sTemp = sTemp & vbCrLf
sValues(i) = sTemp
Next
' WScript.Echo i & ") Got Here: GetBinaryValue " & sTemp
Case 4 ' REG_DWORD
' Gets the DWORD data value of a named value.
E = oReg.GetDWORDValue(iBranch, sSubKey, sNames(i), sValues(i))
' WScript.Echo i & ") Got Here: GetDWORDValue " & sValues(i)
Case 7 ' REG_MULTI_SZ
' Gets the multiple string data values of a named value.
E = oReg.GetMultiStringValue(iBranch, sSubKey, sNames(i),
sValues(i))
' WScript.Echo i & ") Got Here: GetMultiStringValue " &
sValues(i)
End Select
sMsg = Padding(i,3) & ") Name: " & Padding(sNames(i),33) & "
Value: " & sValues(i)
WScript.Echo sMsg
Next
Else
WScript.Echo "NO RECORDS"
End If
End If
End Function
'************************************************************************
'User-defined function to check the result of the operation
'************************************************************************
Function CheckResult(ByRef msg, ByRef error)
If Error <> 0 Then
WScript.Echo "Error occurred in " & msg
WScript.Echo "Code " & Hex(error) & "; Description: " &
error.description
WScript.Echo
WScript.Quit
End If
End Function
'************************************************************************
'Pads strings
'************************************************************************
Function Padding(Value, Length)
' If the length of the value is less than the variable 'length'
If Len(Value) < Length Then
charcount = Length - len(Value)
For i = 1 to (charcount - 1)
padding = padding & " "
Next
mystring = Value & padding
' If the length of the value is greater than the variable 'length'
Elseif len(Value) > Length Then
mystring = Left(Value,Length)
Else
mystring = Value
End If
Padding = mystring
End Function
many thanks Tag: Changing text from upper case to title case Tag: 211462
Outlook Script for Reply Button
We have created a custom Outlook corporate signature in HTML format. When
replying to an email from outside our company, the signature reverts to plain
text if the sender used plain text. I need to get the signature back to HTML.
I beleive I found a VB Sript that will do this however the user would have to
press Alt+F8 to run the macro. How can I get the macro to run by having the
user click on reply and not alt+F8? I'm very new to scripting so detail
instructions would help. We are using both Outlook 2002 and Outlook 2003.
Below is the code I found for changing the signature back to HTML.
Sub ReplyInHTML()
Dim objItem As Object
Dim objReply As MailItem
Set objItem = GetCurrentItem()
If objItem.GetInspector.EditorType <> olEditorHTML Then
' Outlook 2002 can substitute the next statement
' for the above If statement
'If objItem.BodyFormat <> olFormatHTML Then
objItem.HTMLBody = Replace(objItem.Body, vbCrLf, "<br>")
End If
Set objReply = objItem.Reply
objReply.Display
Set objItem = Nothing
Set objReply = Nothing
End Sub
Function GetCurrentItem() As Object
Dim objApp As Application
Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function
Thank you Tag: Changing text from upper case to title case Tag: 211455
Error 428 and 438
I am running a WMI vbscript which reads registry of remote machine and
returns the result. The script takes input from a text file which
contains server names. The script runs fine for few servers and for
few servers it throws error either 428 or 438 (Error: Doesn't support
this property or method).
The servers are running Windows Server 2003 EE. Why is that for few
servers it is giving me the output for rest the error? Tag: Changing text from upper case to title case Tag: 211454
onmouseover and onmouseout considered acceptable in standards?
I am presently developing an HTA and I have implemented the use of
"onmouseover" and "onmouseout", but I was wondering whether these commands
continue to be included in the industry standard specs; does anyone happen to
know?
Thanks much in advance. Tag: Changing text from upper case to title case Tag: 211450
Web Script stopped working
This used to work fine, but for the past week has been failing. Intent is
to open a page called USER.htm where USER is someone's userid. Is there an
error in my old script, or could it be that IE7 being automagically
installed on the web server screwed it up somehow, or what? Any ideas?
Here is the script, which is at the top of an asp file, that takes in the
info:
<%@ Language="VBScript" %>
<%
Set obj = Server.CreateObject("iisPROTECTadmin.admin")
obj.ReloadAccess()
obj.ReloadSettings()
page = request("page")
if ( Request.form("user") <> "" AND Request.form("password") <> "") Then
Response.Cookies("IISPROTECTLOGIN")("USER") = Request.form("user")
encdata = obj.Encrypt( Request.form("password") )
Response.Cookies("IISPROTECTLOGIN")("PW") = encdata
if (Request.Cookies("IISPROTECTLOGIN")("SID") = "") then
response.Cookies("IISPROTECTLOGIN")("SID") = obj.sid
end if
Response.Cookies("IISPROTECTLOGIN").expires = date()+ 365
'Response.Cookies("IISPROTECTLOGIN").Path="/"
if Request.Cookies("IISPROTECTLOGIN").HasKeys then
if (page <> "" ) then
Response.Redirect page
end if
end if
end if
set obj = nothing
%> Tag: Changing text from upper case to title case Tag: 211446
Tick the "For fast searching" box in folder properties
I am involved in scripting an XP workstation add to an Active Directory
domain. This includes setting up Windows Desktop Search. On the image
deployed to all the workstations the "For fast searching, allow Indexing
Service to index this folder" attribute has been unchecked on all folders.
For WDS to function this box must be checked. This attribute can be found by
going to properties of any folder and clicking the Advanced button on the
General tab. I can script ticking or unticking a couple other attributes on
the page, but am unable to find a way for this specific property. Does
anyone have any insight to offer? Thanks for your help!
Tony Tag: Changing text from upper case to title case Tag: 211444
Need to delete files in the RECYCLER bin deleted older then a certain date
For deleting files from anywhere else, I can just use the "datalastmodified"
property to tell if a file is old enough for me to decide to delete. I was
hoping there was a property for the date the file was deleted, like called
"datedeleted" or something, but I can't find any documentation on that, or
method to achieve this some other way. Anyone have an idea? Tag: Changing text from upper case to title case Tag: 211442
Monitor SSL certificate
I need a script which can give me details of X.509 SSL certificate expiry date.
I need to run this script remotely for different servers.
It will be very helpfull if somebody can provide is some script or a tool. Tag: Changing text from upper case to title case Tag: 211440
Error 800703E6 in VBscript
Hi - I am stumped with this error, and would appreciate any insights. I have
a VBscript that is running on approximately 500 computers. The specific
routine in question is to start a service (pcAnywhere Host) on the computer.
This works more than 99% of the time. However, each day, a random computer
has the 800703E6 - Invalid access to memory location error. I have not found
anything unusual about the computer or the pcAnywhere service on the computer
when this happens.
A bit more background:
All PC's have Windows XP
Scripts are run under a local admin account (same account on all PC's)
Rebooting the computer and running the script again results in no error
I am pasting the specific routine below where this error occurs. The error
references the line "For Each..."
strComputer = "."
strService = " 'awhost32' "
Set objWMIService =
GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colListOfServices = objWMIService.ExecQuery ("Select * from
Win32_Service Where Name =" & strService & " ")
For Each objService in colListOfServices
objService.StartService()
if bRunEntireScript then 'only writes to database if the full
script is running
DatabaseInsert "PCAnywhereStatus", objService.State,
objService.Status
DatabaseInsert "PCAnywhereRestart", objService.Name, err.Number
end if
Next
Thank you for your assistance.
Mike Tag: Changing text from upper case to title case Tag: 211438
Newbie needs help w/ simple script ...
Hi guys,
I'm trying to create a simple script to backup some of our files with
WinZip. I think the trouble that I'm having is that the path has space
in it and I can't quite handle it correctly.
I want to grab the current date and I think this is working correctly.
dtmToday = Date()
Wscript.Echo dtmToday
Then I want to create a zip file using the current date in the
filename. The path to WinZip to do this is:
C:\Program Files\WinZip\WINZIP32.EXE" -min -a -r -p -hs c:\tmp
\backup1_test.zip C:\some dir
Except instead of "backup1_test.zip" I would like the filename to be
similar to:
10.25.07_MyArchive.zip
Can anyone give me a hand with this? I imagine this is a trivial
exercise for most of you. ;-)
I'm off to Borders this afternoon to grab a VBScript reference.
Thanks very much in advance!
Chris
http://amateureconblog.blogspot.com/ Tag: Changing text from upper case to title case Tag: 211437
Install a printer
Hi.
How can I install a printer in black and white by default by means of a
script?
Regards Tag: Changing text from upper case to title case Tag: 211432
How to press OK
I have a script that checks the registry to see if a certain key exist. If it
does not, the script then calls an executable via .bat. Once the executabe is
installed, the .bat is set to update a few user settings on the machine.
However, upon completion of the executable, the user is required to select OK
or Finish before the .bat can continue.
Is there a way to have the vbs select OK or Finish for the user so it and/or
the .bat can continue on their way? Tag: Changing text from upper case to title case Tag: 211431
psexec and double quotes
I want to use the following psexec statement in my script:
psexec \\047-GRAPEVINE "C:\Program Files\Microsoft
Office\Office\Powerpnt.exe" /s C:\grapevine\ & filename & ".ppt"
Because I have to wrap parameters in double quotes, do I double the quotes
around the whole statement like this:
'Run the PowerPoint presentation on the 047-GRAPEVINE computer using
psexec.exe
WShell.Run ""psexec \\047-GRAPEVINE "C:\Program Files\Microsoft
Office\Office\Powerpnt.exe" /s C:\grapevine\ & filename & ".ppt""" Tag: Changing text from upper case to title case Tag: 211429
psexec and double quotes
I want to use the following psexec statement in my script:
psexec \\047-GRAPEVINE "C:\Program Files\Microsoft
Office\Office\Powerpnt.exe" /s C:\grapevine\ & filename & ".ppt"
Because I have to wrap parameters in double quotes, do I double the quotes
around the whole statement like this:
'Run the PowerPoint presentation on the 047-GRAPEVINE computer using
psexec.exe
WShell.Run ""psexec \\047-GRAPEVINE "C:\Program Files\Microsoft
Office\Office\Powerpnt.exe" /s C:\grapevine\ & filename & ".ppt""" Tag: Changing text from upper case to title case Tag: 211428
sizes of all "My documents" folders on all PCs
Hi,
I want to find the sizes of all "My documents" folders on all PCs (in a
domain). Is there a script that cando this job?
Thanks in advance. Tag: Changing text from upper case to title case Tag: 211427
IIS Configuration
I am always recreating my IIS virtual directories on to other servers. Is
there an automated way I can recreate entire IIS virtual directory structure
using export and import features of IIS? Any samples/articles would be
great! Tag: Changing text from upper case to title case Tag: 211421
Open a PDF file; execute a hyperlink
I need example VBScript that opens a PDF file (a Reader file); can someone
please post something like that?
Also, I'm assuming you must specify the path - is Acrobat always installed
in the same path, or is there a generic way to open the app?
Is there a way to execute a hyperlink that resides or is defined inside the
same VBScript file? For example, in MS-Excel you can use the following:
ActiveWorkbook.FollowHyperlink Address:=MyFullPath
Thanks much in advance for your assistance. Tag: Changing text from upper case to title case Tag: 211418
enumerate open files IADsFileServiceOperations Interface
Having some trouble finding information about this one. People seem to
have ideas about enumerating open files or enumerating open sessions,
but does anyone know a way to combine the two??
I am looking for a way to enumerate open files on a server and their
corresponding session (or originating system)
The IADsSession and IADsResource Interfaces are not inherently clear
about doing this. Anyone have any ideas?
Thanks!
Tim Tag: Changing text from upper case to title case Tag: 211417
Rename a set of files by file ext using increment from another file
I'm a gross vb newbie - I'm working on that though.
I have several files in folder c:\data\2Rename
File1.Grn
File2.Grn
File3.Blu
I have files corresponding to their extension that hold the current file
count:
Grn.seq (1 record, value 223)
Blu.seq (1 record, value 489)
For each file in the c:\data\2Rename folder I want to rename the current file
based on the extension and the sequence in the .seq file corresponding to
the extension, then increment the contents of the seq file
ren File1.Grn New223.grn
increment the value in Grn.seq to 224
Believe it or not it's not too hard in a DOS batch, but I really need to
start doing things in vb script.
Anybody care to take a stab?
Any help would be MUCH appreciated. Tag: Changing text from upper case to title case Tag: 211413
Finding CD drive in script
Hello,
I use a combination of vbs and batch files in my unattended deployment
of Windows Server 2003. I use the following command in my batch files
to find a cd.txt file on the root of the install CD so I can reference
the path dynamically. It is:
FOR %%i IN (D E F G H I J K L M N O P Q R S T U V W X Y Z) DO IF EXIST
%%i:\CD.txt SET CDROM=%%i:
Unfortunately, I do not know how to perform this inside a vbs file
that I use to determine what hardware the server is and insert a line
in my runonceex later on. The problem is that I have to hard code the
script to use d:\postinstall... as I don't know how to peform the
above FOR/EXIST statement inside the vbs. Is what I am trying to do
possible? I appreciate any insight into this.
The code is as follows:
------------------------------------
'---Start script.vbs---
Option Explicit
'#Declare Variables#
Dim objWMIService,strComputer
Dim colSettings,objComputer
Dim strManufacturer,strModel,objShell
Dim objRegExp
'#Expression Search Info since Dells are whack#
Set objRegExp = New RegExp
objRegExp.IgnoreCase = True
objRegExp.Pattern = "^Dell"
Dim strStringToSearch
'#Define Constants#
'COMMENT: Put your Manufacturer here
'Const MFG1 = "Dell"
Const MFG2 = "IBM"
Const MFG3 = "VMware, Inc."
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root
\cimv2")
Set colSettings = objWMIService.ExecQuery _
("Select * from Win32_ComputerSystem")
For Each objComputer in colSettings
strManufacturer = objComputer.Manufacturer
strStringToSearch = strManufacturer
Next
If objRegExp.Test(strStringToSearch) = True Then
Set objShell = CreateObject("WScript.Shell")
objShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion
\RunOnceEx\047\","Dell OpenManage Install","REG_SZ"
objShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion
\RunOnceEx\047\1","d:\postinstall\DELLOM\openinstall.cmd","REG_SZ"
ElseIf strManufacturer = MFG2 Then
Set objShell = CreateObject("WScript.Shell")
objShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion
\RunOnceEx\047\","IBM Director Install","REG_SZ"
objShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion
\RunOnceEx\047\1","d:\postinstall\IBM\IBMinstall.cmd","REG_SZ"
ElseIf strManufacturer = MFG3 Then
Set objShell = CreateObject("WScript.Shell")
objShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion
\RunOnceEx\047\","VMware Tools Install","REG_SZ"
objShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion
\RunOnceEx\047\1","d:\postinstall\vmware\vmmap.cmd","REG_SZ"
objShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion
\RunOnceEx\048\","VMware Tools Hardware Acceleration","REG_SZ"
objShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion
\RunOnceEx\048\1","d:\postinstall\sethw_accel.cmd","REG_SZ"
End If
'---End script.vbs--- Tag: Changing text from upper case to title case Tag: 211408
please i want script to make ip assigned by dhcp
i used this script to change ip :-
strComputer = "."
Set objWMIService = GetObject( _
"winmgmts:\\" & strComputer & "\root\cimv2")
Set colNetAdapters = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration " _
& "where IPEnabled=TRUE")
strIPAddress = Array("192.168.1.141")
strSubnetMask = Array("255.255.255.0")
strGateway = Array("192.168.1.100")
strGatewayMetric = Array(1)
For Each objNetAdapter in colNetAdapters
errEnable = objNetAdapter.EnableStatic( _
strIPAddress, strSubnetMask)
errGateways = objNetAdapter.SetGateways(_
strGateway, strGatewaymetric)
Next
please
i want script to make ip assigned by dhcp again
thank you Tag: Changing text from upper case to title case Tag: 211404
Parameters in quotes treated as one
Hello. I need to acomplish a task, but I have no idea how to do it.
My script has to pass some text into email.
Set collArg = WScript.Arguments
Dim mail
mail = collArg(0)
Dim topic
topic = collArg(1)
Dim body
body = collArg(2)
Set WshShell = WScript.CreateObject("WScript.Shell")
strCommand = "mailto:" & mail & "&subject=" & topic & "&body=" & body
WshShell.Run strcommand
The thing is that parameters like Subject and Body will have spaces.
Parameters then will be passed in "quotes" and they should be treated
as one parameter. How can I do it? Tag: Changing text from upper case to title case Tag: 211403
Lopping delete row and remove CRLF
Hi all,
I've got 2 codes from previous message posts but need to combine them.
The first bit removes the last 2 characters but only does for one
line, how would I loop it to do many lines so no CRLF (and still
remains in it's orginal layout).
The section bit deletes rows beginning with 345.
I've tried to combine the two but no luck.
Thanks,
Ed
'removes carriage returns and line feeds
Const ForReading = 1
Const ForWriting = 2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\abc.10", ForReading)
strFile = objFile.ReadAll
objFile.Close
intLength = Len(strFile)
strFile = Left(strFile, intLength - 2)
Set objFile = objFSO.OpenTextFile("C:\abc.10", ForWriting)
objFile.Write strFile
objFile.Close
'********************************************************************
'deletes line beginning with 345
strFileName = "C:\scripts\test.txt"
strCheckForString = UCase("345")
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile(strFileName, FOR_READING)
strContents = objTS.ReadAll
objTS.Close
arrLines = Split(strContents, vbNewLine)
Set objTS = objFS.OpenTextFile(strFileName, FOR_WRITING)
For Each strLine In arrLines
If Not(Left(UCase(LTrim(strLine)),Len(strCheckForString)) =
strCheckForString) Then
objTS.WriteLine strLine
End If
Next Tag: Changing text from upper case to title case Tag: 211402
hello - and thanks to all that helped me!
This group, whether by me simply searching for answers for posting
looking for them, has been super super helpful in creating my campus-
wide inventory script. I now have a SQL database populating with
information as folks log in, getting everything from serial number to
model name to hard drive, etc. I want to post my full inventory
script here, so anyone who has been wanting to do something like this
can simply copy/paste and modify as needed! So thanks again, and
copy, modify and enjoy :-)
On Error Resume Next
Const HKEY_LOCAL_MACHINE = &H80000002
DIM strComputerName
strComputer = "."
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &
_
strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources"
strValueName = "Inventory"
strValue = "SQL Server"
objReg.SetStringValue
HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
strKeyPath = "SOFTWARE\ODBC\ODBC.INI\Inventory"
objReg.CreateKey HKEY_LOCAL_MACHINE,strKeyPath
strKeyPath = "SOFTWARE\ODBC\ODBC.INI\Inventory"
strValueName = "Database"
strValue = "Inventory"
objReg.SetStringValue
HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
strValueName = "Driver"
strValue = "C:\WINDOWS\System32\SQLSRV32.dll"
objReg.SetStringValue
HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
strValueName = "Server"
strValue = "CERBERUS"
objReg.SetStringValue
HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
strValueName = "Trusted_Connection"
strValue = "Yes"
objReg.SetStringValue
HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")
objConnection.Open "DSN=Inventory;"
objRecordset.CursorLocation = adUseClient
objRecordset.Open "SELECT * FROM Hardware" , objConnection, _
adOpenStatic, adLockOptimistic
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer& "\root
\cimv2")
Set colSettings = objWMIService.ExecQuery _
("SELECT * FROM Win32_ComputerSystem")
For Each objComputer in colsettings
strComputerName = objComputer.Name
Next
strSearchCriteria = "CompName ='" & strComputerName & "'"
objRecordset.Find strSearchCriteria
IF objRecordset.EOF = True Then
Set colSettings = objWMIService.ExecQuery _
("SELECT * FROM Win32_ComputerSystem")
For Each objComputer in colsettings
objRecordset.AddNew
objRecordset("CompName") = objComputer.Name
objRecordset.Update
Next
call subwritedata
Else
call subwritedata
End If
objRecordset.Close
objConnection.Close
WScript.Quit
'
' Beneath here be Subroutines
'
Sub subwritedata
Set colSettings = objWMIService.ExecQuery _
("SELECT * FROM Win32_ComputerSystem")
For Each objComputer in colsettings
objRecordSet("Memory") = round(objComputer.TotalPhysicalMemory/1024)
& " MB"
objRecordset.Update
Next
Set colSettings = objWMIService.ExecQuery _
("SELECT * FROM Win32_OperatingSystem")
For Each objOperatingSystem in colSettings
objRecordset("OS") = objOperatingSystem.Caption
objRecordset.Update
Next
Set colSettings = objWMIService.ExecQuery _
("SELECT * FROM Win32_Processor")
For Each objCPU in colSettings
objRecordset("Processor") = trim(objCPU.Name)
objRecordset.Update
Next
Set colSettings = objWMIService.ExecQuery _
("SELECT * FROM Win32_DiskDrive")
For Each objDisk in colSettings
objRecordset("HardDrive") = round(objDisk.Size/1000000000) & " GB"
objRecordset.Update
Next
Set colSettings = objWMIService.ExecQuery _
("SELECT * FROM Win32_ComputerSystem")
For Each objComputer in colsettings
objRecordSet("CompType") = objComputer.Model
objRecordset.Update
Next
Set colsettings = objWMIService.ExecQuery _
("SELECT * FROM Win32_BIOS")
For Each ObjBIOS in colsettings
objRecordset("Serial") = objBios.SerialNumber
objRecordset.Update
Next
Set colChassis = objWMIService.ExecQuery _
("Select * from Win32_SystemEnclosure")
For Each objChassis in colChassis
For Each strChassisType in objChassis.ChassisTypes
If strChassisType = 8 THEN
objRecordset("Chassis") = "Laptop"
ElseIf strChassisType = 9 THEN
objRecordset("Chassis") = "Laptop"
ElseIf strChassisType = 10 THEN
objRecordset("Chassis") = "Laptop"
ElseIf strChassisType = 12 THEN
objRecordset("Chassis") = "Laptop"
ElseIf strChassisType = 13 THEN
objRecordset("Chassis") = "Laptop"
ELSE
objRecordset("Chassis") = "Desktop"
End If
objRecordset.Update
Next
Next
Set colsettings = objWMIService.ExecQuery _
("SELECT * FROM Win32_BIOS")
For Each ObjBIOS in colsettings
objRecordset("ReleaseDate") = left(objBios.ReleaseDate,8)
objRecordset.Update
Next
Set colSettings = objWMIService.ExecQuery _
("SELECT * FROM Win32_ComputerSystem")
For Each objItem in colSettings
arrName = Split(objItem.UserName, "\")
objRecordset("Login") = arrName(1)
objRecordset.Update
Next
Set colItems = objWMIService.ExecQuery _
("Select * From Win32_NetworkAdapterConfiguration " & _
"Where IPEnabled = True")
For Each objItem in colItems
For Each objAddress in objItem.IPAddress
objRecordset("IP") = objAddress
objRecordset.Update
Next
Next
Set colItems = objWMIService.ExecQuery _
("Select * From Win32_NetworkAdapterConfiguration " & _
"Where IPEnabled = True")
For Each objAdapter in colItems
objrecordset("Mac") = objAdapter.MacAddress
objRecordset.Update
Next
objRecordset("Date") = Date()
objRecordset.Update
objRecordset("Time") = Time()
objRecordset.Update
End Sub Tag: Changing text from upper case to title case Tag: 211400
Defrag Hard Disks
I am using the following script to automate the defrag of all volumes
on a server, is it possible to make the script wait and not exit until
the defrag is complete. This is destined to become the last part of a
"first boot" script used in server deployment so I would like to have
the script initiate a reboot once this is finished.
'execute against the local computer
strComputer = "."
'connect to the WMI service on strComputer
Set objWMIService = GetObject("winmgmts:" &
"{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'Defrag All Hard disks
Set colVolumes = objWMIService.ExecQuery ("Select * from
Win32_Volume")
For Each objVolume in colVolumes
errResult = objVolume.Defrag()
Next
Thanks,
Josh Tag: Changing text from upper case to title case Tag: 211399
Install a printer in black and white
Hi.
How can I install a printer in black and white by default by means of a
script?
Regards Tag: Changing text from upper case to title case Tag: 211392
Selecting current week in drop down
Hi All,
In a drop down box i am populating all the weeks from 1 to 52, but
whenever the page loads, i want it show the current week number as
selected value.
Below is what is did:
<option selected value="<% DatePart("ww", Now()) %>"> <% wkCnt %> </
option>
But when my page loads, the drop down box shows the last week in the
list (52), instead of current week which is 43.
please let me know i am missing something.
appreciate any ideas on this.
Thank you!!
Navin Tag: Changing text from upper case to title case Tag: 211391
Do not support HTML in textarea - on server-side
Hi,
I have a textarea and I would like to prevent users from inserting
HTML tags. Only plain text is supported.
Which server-side vbscript regular expression is best for this?
Thanks, Gabi Tag: Changing text from upper case to title case Tag: 211390
Help Splitting a String
Can anyone help me please.
I am trying to split a users homedrive which I input using the
following code, the problem is I get an error when trying to split the
name. I basically want to get the servername and the home drive share
name as two seperate values so I can then use them seperatly.
The Home drive is displayed as "\\Servername\Sharename$"
username = "HJSimpson"
Const ADS_PROPERTY_DELETE = 4
Const ADS_PROPERTY_APPEND = 3
'Open connection to AD using LDAP
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
strBase = "<LDAP://dc=name,dc=name>"
strFilter = "(&(objectCategory=person)(sAMAccountName=" & username &
"))"
strAttributes = "sAMAccountName,AdsPath,distinguishedName"
strQuery = strBase & ";" & strFilter & ";" & strAttributes
objCommand.CommandText = strQuery
Set ADSIRecordSet = objCommand.Execute
strName = ADSIRecordSet.Fields("sAMAccountName").Value
errorNum = err.number
errorDesc = err.description
strAdsPath = ADSIRecordSet.Fields("AdsPath").Value
strDN = ADSIRecordSet.Fields("distinguishedName").Value
Set objUser = GetObject("LDAP://" & strDN)
strDisplayName = objUser.displayname
strDescription = objUser.description
err.number = "0"
Set usr = GetObject(strAdsPath)
homedir = usr.homedirectory
MsgBox homedir - This bit is OK
a=Split(homedir,"\",-1,1) - This bit is not OK.
If InStr(a, "\\") Then
newservername = len(a,3)
Else
'Do Nothing
End If
MsgBox newservername
WScript.Quit:
Please help. Thanks Tag: Changing text from upper case to title case Tag: 211389
Error 800A0046 with Shell.Run, but .Exec works
Hello,
I use VBScript to execute an application on a network drive.
The script looks like this:
<-----------------
const cFolder = "S:\Apps\MyProg"
const cPrg = "prg.exe"
set oShell = CreateObject("WScript.Shell")
with oShell
.CurrentDirectory = cFolder
call .Run(cFolder & "\" & cPrg)
end with
<-----------------
With some users, this script fails executing "call .Run()" with error
800A0046 - Permission denied.
If I replace "call .Run()" with "call .Exec()" using exact the same parameter,
the same user can run the script without any problems.
What is the difference between .Exec and .Run?
Why does .Run fail sometimes?
Thank you very much,
Josef Tag: Changing text from upper case to title case Tag: 211385
Edit a txt file
Dear All,
Pls help, I have a text file which I need to edit. The script should
search for a particular text using readline and then append a certain
text to that line.
The text file looks like
blah blah
blah blha
blah
happyb'day=gaurav
blah blah
It should look like this after modification
blah blah
blah blha
blah
happyb'day=gaurav,thanks
blah blah
P.S - The line # where "Happy'bday=gaurav" is not fixed.
Pls help, I need to get going on this and even a little insight will
be very helpful.
Thanks in advance
Gaurav Tag: Changing text from upper case to title case Tag: 211380
MS Office 2003 Author change
Is there a way to change the author of documents created by word, excel, etc,
so that it reflects the user that is logged in and not the organization? I
would like to create a script so this is done automatically but it seems that
UserInfo in the registry is encrypted. Is there a way around this or an
additional key that can be entered? This is to prevent students from copying
other student's work in an Office class. Tag: Changing text from upper case to title case Tag: 211379
Win2k3 > SP2 - Anything that can/will affect LDAP queries?
Hi,
Is there anything in SP2 for Windows Server 2003 that could affect
LDAP queries that we currently have in place that anyone knows of?
Thanks in advance. Tag: Changing text from upper case to title case Tag: 211377
Reading the + in Querystring
Hi All,
I have a querystring that contains the + sign as a separator, I need to read
these values individually in a select statement, for example.
&text=Single+205
where single is the type of room somebody wants and 205 is the user ID in
the Customer table.
Please help.
Regards
Simon Tag: Changing text from upper case to title case Tag: 211373
netobj.GetSystemInfo() in ASP/VBScript
I am looking to find the IP address, MAC address, Windows Version etc. and
ideally I want to know if some specific components are installed such as our
plugin to WM Player. Is this possible in ASP? I know it is in
.Net and in Javascript there is this function netobj.GetSystemInfo()
How would I do this in plain ASP and/or ASP with vbscript?
Thanx,
--
Anil Gupte
www.keeninc.net
www.icinema.com Tag: Changing text from upper case to title case Tag: 211372
Change value of "Logon script" for all users to nothing
Hi,
I'm relatively new to VBScript. I have successfully written a couple
of logon scripts for my company, with half-decent validation & program
flow. I now need to deploy this, and remove the old batch logon script
from users' account objects in AD.
Having read some posts, I've seen suggestions ranging from:
selecting multiple users in AD & selecting "Properties", then making
the change (this doesn't work on either WinXP SP2 or Win 2000)
to
using LDIFDE to export the desired information, make the change, then
re-import this data to update the schema. However, LDIFDE looks
extremely complex & bug-prone - see http://support.microsoft.com/kb/555634.
For example, this document suggests that blank values can't be used to
set attributes, which ruins my plans. It also contains lots of caveats
- by default, accounts are disabled, passwords set to NULL, "user must
change password at next logon", etc, making for a very complex series
of switches & arguements for performing any import.
Is there no way of simply using VBScript to build a collection of user
objects and loop through them, setting the desired value? Any
suggestions would be greatly appreciated.
Many thanks,
Stevie
"Normal is as normal does..." Tag: Changing text from upper case to title case Tag: 211371
passing a WMI collection value as a property
Hi, Please Help !
I am trying to write a script that loads some counter details from a SQL
table, executes a WMI query and then writes the results back to a SQL table.
The script will loop through the counters that it loads. My problem is I run
my WMI query
set colsettings = objWMIService.ExecQuery("SELECT PercentProcessorTime FROM
Win32_PerFormattedData_PerfOS_Processor where name = '_Total'). The actual
query contains references to the recordsets returned from SQL server
containing the counter details. For example "PercentProcessorTime" above is
replaced with objCounterRecordSet.Fields.Item("WMIProperty") and also the WMI
Class is replaced with a reference to the recordeset.
I now have one element in the reurned collection which I have to loop
through. For testing I am only trying to retrieve the value.
For each objItem in colsettings
wscript.echo objitem.PercentProcessorTime
Next.
The problem is I have several counters in my SQL table and am looping
through them so I need to replace "PercentProcessorTime" above with which
ever WMIClass parameter I happen to be working with and I cannot get this to
work. I guess what I am trying to do is use the value in a recordset as a
property for an object.
Anybody got any ideas or am i trying to do something that cannot be achieved. Tag: Changing text from upper case to title case Tag: 211369
Problems creating an exchange mailbox and setting permissions
Hi All,
I hope someone can help.
I am having problems accessing the Security Descriptor when creating a
New User. It errors telling me an object is required with error 424.
I have this working on other infrastructures the same as it is in this
code and therefore can not understand why it is not working.
The bit of the code which is failing is the Function to Create The
Exchange Mailbox the rest is working fine.
Here is the code
---------------------------------------------------------------------------------------------------------------------------------------------------------------------
<HTML>
<HEAD>
<TITLE>New User Creation Utility</TITLE>
<HTA:APPLICATION ID="oCreateAccount"
APPLICATIONNAME="AccountCreationScript"
BORDER="thin"
CAPTION="yes"
ICON="SETUP.ICO"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
SCROLL="NO"
SYSMENU="yes"
WINDOWSTATE="normal"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="yes">
</HEAD>
<style>
BODY
{
background-color: "#E4EAF6";
font-family: Helvetica;
font-size: 14pt;
color: "#000080";
margin-top: 5%;
margin-left: 5%;
margin-right: 5%;
margin-bottom: 5%;
}
</STYLE>
<SCRIPT LANGUAGE="VBScript">
<!--
'=================================================================================================================================================
'***When the Script window loads set the size and location of the
window.***
'=================================================================================================================================================
sub Window_Onload
self.focus()
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer &
"\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From
Win32_DesktopMonitor")
For Each objItem in colItems
intHorizontal = objItem.ScreenWidth
intVertical = objItem.ScreenHeight
Next
intLeft = (intHorizontal - 800) / 2
intTop = (intVertical - 600) / 2
window.resizeTo 800,600
'window.moveTo intLeft, intTop
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
end sub
'=================================================================================================================================================
'***Clear any stored Values from the entry fields.***
'=================================================================================================================================================
sub btnReset_Click
txtFirstname.value = ""
txtMiddlename.value = ""
txtLastname.value = ""
txtRefnumber.value = ""
txtRequestor.value = ""
ListAccType.value = "AccTypeStart"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
end sub
'=================================================================================================================================================
'***Collect information for new user entered by the Administrator.***
'=================================================================================================================================================
sub btnRunScript_click
firstname=txtFirstname.value
middlename=txtMiddlename.value
lastname=txtLastname.value
referencenumber=txtRefnumber.value
Requestor=txtRequestor.value
AccountType=ListAccType.value
'Formatting the text to make sure that the details are correct
firstname=UCASE(left(firstname,1))+LCASE(mid(firstname,2))
middlename=UCASE(left(middlename,1))+LCASE(mid(middlename,2))
If mid(lastname,2) = "'" Then
lastname=UCASE(left(lastname,3))+LCASE(mid(lastname,4))
Else
lastname=UCASE(left(lastname,1))+LCASE(mid(lastname,2))
End If
btnRunScript.disabled = true
btnReset.disabled = true
btnClose.disabled = true
if firstname="" then
msgbox "Please enter the users First Name"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
exit sub
elseif lastname = "" then
msgbox "Please enter the users Surname"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
exit sub
elseif referencenumber = "" then
msgbox "Please enter the Reference Number"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
exit sub
elseif Requestor = "" then
msgbox "Please enter the Requestor's Name"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
exit sub
elseif AccountType = "AccTypeStart" then
msgbox "Please select the Account Type"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
exit sub
else
'do nothing
end if
call
createAccount(firstname,middlename,lastname,referencenumber,Requestor,AccountType)
end sub
'=================================================================================================================================================
'***Collect information for new user entered by the Administrator,
then create the account.***
'=================================================================================================================================================
sub
createAccount(firstname,middlename,lastname,referencenumber,Requestor,AccountType)
'On error resume next
intAccValue = 544
inputdomain="Domain"
inputou="OU"
Set wshshell = CreateObject("wscript.shell")
username = wshshell.expandenvironmentstrings("%username%")
strDomain="Domain.Com"
CurrDateTime=now
firstinitial = UCASE(left(firstname,1))
strFile = "filepath"
strExServer = "Servername"
strProfPath = "\\Servername\User$\P"
strHomeDir = "\\Servername\User$\H"
strTempPath = strHomeDir & firstinitial & "\_Template\"
msgbox "Please verify the following details of the account to create"
& VBCRLF & "Firstname: " & firstname & VBCR & "Middlename: " &
middlename & VBCR & "Lastname: " & lastname & VBCR & "Reference
Number: " & referencenumber
MsgboxResult=msgbox("Is this information correct?",
259,"Confirmation")
if MsgboxResult = 7 then
txtFirstname.value = ""
txtMiddlename.value = ""
txtLastname.value = ""
txtRefnumber.value = ""
ListAccType.value = "AccTypeStart"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
exit sub
elseif MsgboxResult = 2 then
window_close
exit sub
else
'do nothing
end if
'Connect to the usersdatabase to get sitedetails and record the
transaction
set conn=createobject("adodb.connection")
conn.connectiontimeout = 30000
conn.commandtimeout=30000
set myset=createobject("adodb.recordset")
conn.open "Driver={Microsoft Access Driver
(*.mdb)};Dbq=UserAdmin.mdb;"
sql="select * from Exchange where exchangeserver='" & strExServer &
"'"
'Msgbox sql
set myset=conn.execute(sql)
exchangeserver=myset("exchangeServer")
storagegroup1=myset("storagegroup1")
storagegroup2=myset("storagegroup2")
informationstore1=myset("informationstore1")
informationstore2=myset("informationstore2")
informationstore3=myset("informationstore3")
informationstore4=myset("informationstore4")
informationstore5=myset("informationstore5")
informationstore6=myset("informationstore6")
informationstore7=myset("informationstore7")
informationstore8=myset("informationstore8")
informationstore9=myset("informationstore9")
'Create a temporary account name
testusername=UCASE(left(firstname,1) & left(middlename,1) &
left(lastname,1)) & LCASE(mid(lastname,2))
'Check if there is an account with this name already
nameok=testaccount(testusername)
if nameok=0 then
' The account name is already in use, need to alter the name used
msgbox "This Account name is already in use, there is a duplicate
entry." & VBCRLF & "Please verify the details entered, you will need
to start again once the details have been verified."
txtFirstname.value = ""
txtMiddlename.value = ""
txtLastname.value = ""
txtRefnumber.value = ""
txtRequestor.value = ""
ListAccType.value = "AccTypeStart"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
exit sub
else
' This name is free so use it
end if
'Now we create the base user account so that we can assign properties
to it
objectname="LDAP://ou=users,ou=" & inputou & ",dc=" & inputdomain &
",dc=COM"
'Now we create the new user account so that we can set its properties
Set ou = GetObject(objectname)
'Have to remember to escape the , by preceeding it with a \, so
smith, john becomes smith\, john this still shows as smith, john in
the gui though.
If middlename = "" Then
fullname="cn=" & firstname & " " & lastname
Else
fullname="cn=" & firstname & " " & middlename & " " & lastname
End If
Set usr = ou.Create("user", fullname)
usr.Put "samAccountName", testuserna