Delete registry folder and sub folder using VBS - vbscript

I want to delete registry folder and sub-folder under it using vb script.
In reg file we can script like below:
[-HKEY_LOCAL_MACHINE\SOFTWARE\abc\prr]
Above script will delete sub-folder under prr
How to achieve same using VB script?
I tried using .RegDelete but I think it work only for key and not for registry folder.
Thanks.

[path] RegDelete [Key] | [Value]
Path Path to RegDelete (so Windows can find it). See the tip on the Windows 98 Tips and Hacks page to make Windows always find it.
Nothing Starts RegDelete with a User Interface. Do not enclose keys or values in inverted commas when typing the key or value to delete.
Key The key to delete. Keys always end in a backslash. If the key contains a space it must be enclosed in inverted commas. Keys and sub-keys will be deleted.
Value The value to delete. Values do not have a trailing backslash. If the key contains a space it must be enclosed in inverted commas.
Copy the following lines into a new text document and save as RegDelete.vbs.
'RegDelete.vbs
'Deletes keys or values from the registry.
'
'
On Error Resume Next
vbPara=vbCRLF & vbCRLF
strExplain="RegDelete deletes keys and values from the registry." & vbPara & "Keys must end with a backspace and values must not." & vbPara & "Start without parameters to type in a key or value to delete, or place the key or value on the command line (use inverted commas to surround the key or value if it contains spaces)." & vbPara & "Continue"
strTitle="Reg Delete"
Key=""
Dim silent
Silent=""
Dim Sh
Set Sh = WScript.CreateObject("WScript.Shell")
ReportErrors "Creating Shell"
Key=GetKey()
If Key<>"" then
B=Sh.RegRead (Key)
If Err.Number=0 Then
Sh.RegDelete Key
If Err.Number =0 Then
If silent<>"yes" Then MsgBox Key & " deleted", vbOKOnly + vbInformation, strTitle
Else
ReportErrors "DeletingKey"
End If
Else
If Err.Number=-2147024893 then
Err.Clear
MsgBox Key & " didn't exist", vbOKOnly + vbCritical, strTitle
Else
ReportErrors "Reading before Deleting Key"
End If
End If
End If
ReportErrors "Main"
Function GetKey()
Dim Ag
Set Ag=Wscript.Arguments
ReportErrors "Creating Aguments"
If Ag.Count=1 then GetKey=Ag(0)
Silent="yes"
If Ag.Count >1 then sgBox "Too many parameters on command line. Try enclosing the key in a space",vbOKOnly + vbCritical, strTitle
If Ag.Count=0 then
If MsgBox (strExplain, vbYesNo + vbInformation, strTitle)=6 Then
GetKey=InputBox ("Enter the value or key to delete." & vbPara & "Keys must end in a backspace.", strTitle, strNamet1)
End If
End If
End Function
Sub ReportErrors(strModuleName)
If err.number<>0 then Msgbox "Error occured in " & strModuleName & " module of " & err.number& " - " & err.description & " type" , vbCritical + vbOKOnly, "Something unexpected"
Err.clear
End Sub

Related

Searching the registry with vbs to find an unknown part of the path

I use a path to locate pieces of information that contains a guid that can change. I had the guid value hard coded, but when it changes it doesn't function. I need to discover that guid dynamically. I know a value on the other side of the guid and have a REG Query that finds the entire path, but I can't figure out how to capture that path.
Here's the REG Query:
REG Query HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products /D /V /F "Microsoft Office Professional Plus 2010" /S /E
It returns the Value "DisplayName" and it's contents "Microsoft Office Professional Plus"
When run from a batch file it also displays the entire path that includes the elusive guid. I would like to do this from a vb script.
Also the newer Windows Scripting Host Shell object also makes registry access easy.
Set wshshell = CreateObject("WScript.Shell")
wshshell.RegDelete(strName)
wshshell.RegRead(strName)
wshshell.RegWrite(strName, anyValue [,strType])
See https://msdn.microsoft.com/en-us/library/293bt9hh(v=vs.84).aspx
Also WMI can access registry. Unlike both above methods it can ennumerate, so you can see what is there without having to know in advance.
Dim proglist()
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
ret = oReg.EnumKey(&H80000002, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall", proglist)
If err.num =0 then
For each prog in proglist
msgbox prog
Next
Else
Msgbox err.num & " " & err.description & " " & err.source
err.clear
End If
https://msdn.microsoft.com/en-us/library/aa390387(v=vs.85).aspx
It can also check security and monitor changes to keys.
This monitors changes to Windows Uninstall key.
Set objWMIService = GetObject("winmgmts:root/default")
Set objEvents = objWMIService.ExecNotificationQuery("SELECT * FROM RegistryTreeChangeEvent WHERE Hive='HKEY_LOCAL_MACHINE' AND RootPath='SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall'")
Do
Set objReceivedEvent = objEvents.NextEvent
msgbox objReceivedEvent.GetObjectText_()
Loop
https://msdn.microsoft.com/en-us/library/aa393041(v=vs.85).aspx‎
Recursion is used to walk each node in a tree. The function calls itself every time it comes across a node. Start below program using cscript to avoid a few thousand msgboxs - cscript //nologo c:\folder\RecurseReg.vbs.
Set wshshell = CreateObject("WScript.Shell")
EnumReg "SOFTWARE\CLASSES"
Sub EnumReg(RegKey)
On Error Resume Next
wscript.echo "---------------------------------------"
wscript.echo "HKLM\" & RegKey & " = " & wshshell.RegRead("HKLM\" & RegKey & "\")
err.clear
Dim KeyList()
Dim ValueNameList()
Dim ValueList()
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
If err.number <> 0 then
wscript.echo err.number
err.clear
End If
ret = oReg.EnumValues(&H80000002, RegKey, ValueNameList, ValueList)
If err.number = 0 then
For each valuename in ValueNameList
If valuename <> "" then
Value = wshshell.RegRead("HKLM\" & RegKey & "\" & valuename)
err.clear
wscript.echo valuename & " - " & Value
End If
Next
Else
Msgbox err.num & " " & err.description & " " & err.source
err.clear
End If
ret = oReg.EnumKey(&H80000002, RegKey, Keylist)
If err.number =0 then
For each key in keylist
EnumReg RegKey & "\" & key
Next
Else
Msgbox err.num & " " & err.description & " " & err.source
err.clear
End If
End Sub
Putting both together (this does VC 2008 Runtime which should be on all computers)
Dim proglist()
Set wshshell = CreateObject("WScript.Shell")
On Error Resume Next
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
ret = oReg.EnumKey(&H80000002, "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products", proglist)
If err.num =0 then
For each prog in proglist
' msgbox prog
If wshshell.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\" & Prog & "\InstallProperties\DisplayName") = "Microsoft Visual C++ 2008 Redistributable - x64 9.0.30729.17" then
Msgbox "Found " & Prog
End If
Next
Else
Msgbox err.num & " " & err.description & " " & err.source
err.clear
End If
For V6 or VBA
The registry is simple in VBA. It's is very limited and uses ini file concepts.
There's a few of them such as (from Object Browser [F2] in VBA editor)
Function GetAllSettings(AppName As String, Section As String)
Member of VBA.Interaction
Sub SaveSetting(AppName As String, Section As String, Key As String, Setting As String)
Member of VBA.Interaction
Sub DeleteSetting(AppName As String, [Section], [Key])
Member of VBA.Interaction
Function GetSetting(AppName As String, Section As String, Key As String, [Default]) As String
Member of VBA.Interaction
Also the Windows API calls can be used.
RegOpenKeyEx
The RegOpenKeyEx function opens the specified registry key.
LONG RegOpenKeyEx(
HKEY hKey, // handle to open key
LPCTSTR lpSubKey, // subkey name
DWORD ulOptions, // reserved
REGSAM samDesired, // security access mask
PHKEY phkResult // handle to open key
);

Issues in Error handling sub in VB Script

I have written an error handling sub in my vb script
errorNumber = DoAllWork
Sub ErrorHandling (Number, Description, i)
If Number <> 0 Then
WriteLogFileLine logfile, "Error No : " & Number & " - " & Description & " has occurred !"
Else
WriteLogFileLine logfile, "Success copying files as Err.Number : " & Err.Number & "Total " & i & " files were copied ! " & vbcrlf
End If
Err.Clear
End Sub
And I am calling it in my vb script like this
Function DoAllWork
On Error Resume Next
Err.Clear
Do Until CopyFiles.AtEndOfStream
line = CopyFiles.ReadLine
For Each line In CopyFiles
If objFSO.GetFolder(line).Files.Count <> 0 then
WriteLogFileLine logfile, "Copying files FromLocation " & Chr(34) & line & Chr(34) & " to ToLocation " & Chr(34) & ToLocation & Chr(34)
Else
WriteLogFileLine logfile, "No files present in the folder " & Chr(34) & line & Chr(34) & vbcrlf
End if
i=0
For Each File In objFSO.GetFolder(line).Files
objFSO.GetFile(File).Copy ToLocation & "\" & objFSO.GetFileName(File),True
i=i+1
Next
ErrorHandling Err.Number, Err.Description, i
Next
Loop
End Function
Now the log file which is getting created has this error messages logged in it even though the files has got copied successfully. Can someone please suggest what is wrong with this error handling technique ??
2015-12-15 15:03:47 - Copying files FromLocation "\\srv10219\archive\Article\20151116_073104" to ToLocation "C:\Users\TEMPPAHIR\LearnVB\ICCdata\Article"
2015-12-15 15:03:47 - Error No : 438 - Object doesn't support this property or method has occurred !
when I place this error handling directly after the File.copy statement, it gives me such log..
2015-12-15 16:31:55 - Error No : 438 - Object doesn't support this property or method has occurred !
2015-12-15 16:31:55 - Success copying files as Err.Number : 0
2015-12-15 16:31:55 - Total 2 files were copied !
that means for the first file which is being copied it throws an error and for the second one it gives success even though both the files has been copied successfully
I implemented this to do pretty much what you asked. What the script needed to do was take a folder and its contents that was dropped into a directory, and then copy the contents to a new folder formatted correctly where there was a poller that picked up the files and entered them in our system. I needed the script to quit on any error, especially for the last thing to do. That was to delete the folder from the source directory, but I had to make sure it got copied correctly. (You could clear the error and continue as well.)
So after each important line like a folder create or a file copy I did this check. This worked for me to do error handling. Passing the Err object itself is the best way to go.
Set FolderCreate = FSO.CreateFolder(PreStagingDirectory + "\" + FolderCreateName)
ReportErrors Err,"Error creating folder: " + PreStagingDirectory + "\" + FolderCreateName
FSO.CopyFile objFile.Path, FolderCreate.Path + "\", true
ReportErrors Err,"Error copying file: " + objFile.Path + " to location: " + FolderCreate.Path
Sub ReportErrors(ErrorObject, strExtraInformation)
'This will log any errors if they happen and the script will then quit
If ErrorObject.Number <> 0 Then
OutPutFile.WriteLine(DateTimeString + " Error Number: " & ErrorObject.Number)
OutPutFile.WriteLine(DateTimeString + " Error (Hex): " & Hex(ErrorObject.Number))
OutPutFile.WriteLine(DateTimeString + " Source: " & ErrorObject.Source)
OutPutFile.WriteLine(DateTimeString + " Description: " & ErrorObject.Description)
OutPutFile.WriteLine(DateTimeString + " Other Information: " + strExtraInformation)
OutPutFile.WriteLine(DateTimeString + " Script is quitting due to the Error Condition.")
wscript.quit
End If
End Sub
I have also done code like this. In this case I needed to catch if null was returned from a SQL query to the database. If null was returned and I try to cast the value, it caused an error.
To answer the question of should you check for errors in a sub and clear them, or check for errors all through your script really depends what you need to accomplish.
First I have to say error handling in vbscipt just sucks. Using 'On Error Resume Next', is absolutely needed but be careful where you place it. I found it is not best to place it in main, at the top, just within each function. Most important is to remember the scope, if you put it in a function, you catch the error there, and can handle it. If you only have it at as the first line of your script, you can only handle an error in main. It is needed in main, sometimes.
Also to debug any vbscript, comment out any call to that, or you will never know the problem.
ExecutionString = "select Sum(cast(Frame_Count as int)) from Sop_Instance_T"
Set objRecordSet = objConnection.Execute(ExecutionString)
TotalFrames = cdbl(objRecordSet(0))
'In case null is returned catch the exception
'that happens on the above line
If Err.Number <> 0 Then
TotalFrames = 0
Err.Clear ()
End If

VBS using LIKE to compare strings "Sub or Function not defined"

I'm trying to make a script to connect a network printer to a user computer.
The script uses the computer name who needs the printer as a parameter.
Printers names are similar their printserver name, eg. server_USA has printers like printer_USA01, printer_USA02.
But it's throwing the error "Sub or Function not defined" when arrives at the first like... why ?
Set shl = WScript.CreateObject("WScript.Shell")
strName = Wscript.Arguments.Item(0)
'input Printer name
strPrinter = InputBox("Please enter share name of printer to install:", _
"Add network printer")
if strPrinter = "" then
msgbox "Can't be empty."
WScript.quit
elseif strPrinter Like "printer_USA*" then
strServer = server_USA
elseif strPrinter Like "printer_SPAIN*" then
strServer = server_SPAIN
else
'Printer name NOT registered, input printserver manually:
strServer = inputbox("Please enter the name of the printserver","printserver")
if strServer = "" then
msgbox "Can't be empty."
WScript.quit
End if
End if
'ADD
shl.run "RUNDLL32 PRINTUI.DLL,PrintUIEntry /ga /c\\" & strName & " /n\\" & strServer & "\" & strPrinter
there is no Like operator in VBScript. You could use Instr.
if strPrinter = "" then
msgbox "Can't be empty."
WScript.quit
elseif Instr( 1, strPrinter, "printer_USA", vbTextCompare ) > 0 then
strServer = server_USA
The vbTextCompare constant ( value=1) is used to Perform a textual comparison
you can use StrComp to have same result in this way
If StrComp(strPrinter,"printer_USA",vbTextCompare)=0 then
strServer = server_USA
End IF
equal 0 mean zero different between strPrinter and printer_USA with ignore the letter case because we use vbTextCompare .
You can replace vbTextCompare with 1 and you will have same result.
If letter case is important you can use vbBinaryCompare or 0.
A way to do that with select case. This version of instr() is case sensitive, but other versions aren't. instr() returns the position of the found substring, which here is always one.
select case 1
case instr(strPrinter, "") + 1
wscript.echo "empty"
case instr(strPrinter, "printer_USA")
wscript.echo "server_USA"
case instr(strPrinter, "printer_SPAIN")
wscript.echo "server_SPAIN"
case instr(strPrinter, "printer_ITALY"), instr(strPrinter, "printer_RUSSIA")
wscript.echo "other known ones"
case else
wscript.echo "not registered"
end select
I used the following alternative (VBScript Regular Expressions)…
Uses slightly different syntax from LIKE but easiest solution to make a match successfully similar to LIKE operator.
dim regExp
set regExp=CreateObject("VBScript.RegExp")
regExp.IgnoreCase = true
regExp.Global = true
regxp.Pattern = ".*Test Pattern.*" ' example only, basic pattern
if regExp.Test(MyString) then
' match successful
end if

Isolating numbers in folder names

I have created a script, out of snip-its found all over this site and elsewhere, to assign job numbers. It (is supposed to) search the "Jobs" directory for the highest job number, increment by 1, prompt for a customer name and job name, copy a template dir and rename it with the information provided. I know my code is messy, but it worked wonderfully...until someone put numbers in the job name (09889KM-TCM-Vadata PDX50 - POD 3). It now does it's intended job, but then runs again with the next number it finds in the job name i.e. increments 09889 to 09890 then picks up on PDX50 and tries to make a new folder 00051. I have been looking all day to find how to isolate the numbers on my own and, but as this script is in production I have no choice to beg for help. Please assist on how to isolate the first 5 digits, or make it stop after one run.
Option Explicit
Dim objFSO
Dim objNewFolder
Dim fs
Dim MainFolder
DIM JobNumber, nJobNumber, EmplInit, CustName, JobName
Dim fldr, LastName, LastJob, r, x, y
Dim OldFolder, sFile
'Find Highest Job Number Folder
Set fs = CreateObject("Scripting.FileSystemObject")
Set MainFolder = fs.GetFolder("C:\Test\")
For Each fldr In MainFolder.SubFolders
If fldr.Name > LastName Then
LastJob = fldr.Name
LastName = fldr.Name
End If
Next
'Extract JobNumber from name and increment by 1, and format to five numbers
Set r=new regexp
r.pattern="[0-9]+"
r.global=true
x=LastJob
Set y=r.execute(x)
For each JobNumber in y
JobNumber = Right("00000" & JobNumber, 5)
nJobNumber = JobNumber + 1
nJobNumber = Right("00000" & nJobNumber, 5)
' Start recieving input
' Get initials
EmplInit = InputBox ("The last Job Number is: " & VbCrLf & Jobnumber & VbCrLf & "You have been assigned Job Number: " & VbCrLf & nJobNumber & VbCrLf & "Please Typer your initials:","Initials")
If IsEmpty(EmplInit) Then
MsgBox "Canceled"
ElseIf Len(EmplInit) = 0 Then
MsgBox "You Clicked OK but left the box blank"
Else
'Get Customer Name
CustName = InputBox ("Please enter your customer's name:","Customer Name")
If IsEmpty(EmplInit) Then
MsgBox "Canceled"
ElseIf Len(EmplInit) = 0 Then
MsgBox "You Clicked OK but left the box blank"
Else
'Get Job Name
JobName = InputBox ("Please enter your job's name:","Job Name")
If IsEmpty(EmplInit) Then
MsgBox "Canceled"
ElseIf Len(EmplInit) = 0 Then
MsgBox "You Clicked OK but left the box blank"
Else
' Create New Job Folder Name
objNewFolder = ("C:\Test\" & nJobNumber & EmplInit & "-" & CustName & "-" & JobName)
'Create the File System Object
Set objFSO = CreateObject ("Scripting.FileSystemObject")
'Get the folder we want to copy from
OldFolder = "C:\Test\00AA-Working Edit - Folder Template\"
'Check if new folder exists, if not then create it.
If objFSO.FolderExists (objNewFolder) then
WScript.Echo "The Destination Folder " & objNewFolder & " already exists"
Else
WScript.Echo "The Destination Folder " & objNewFolder & " will be created."
Set objNewFolder = objFSO.CreateFolder (objNewFolder)
End If
'Copy source folders to new folder
objFSO.CopyFolder "C:\Test\00AA-Working Edit - Folder Template\*" , (objNewFolder & "\")
'Copy any files in the source root to new location
For Each sFile In objFSO.GetFolder(OldFolder).Files
If Not objFSO.FileExists(objNewFolder & "\" & objFSO.GetFileName(sFile)) Then
objFSO.GetFile(sFile).Copy objNewFolder & "\" & objFSO.GetFileName(sFile),True
End If
Next
End If
End If
End If
Next
Change this:
'Extract JobNumber from name and increment by 1, and format to five numbers
Set r=new regexp
r.pattern="[0-9]+"
r.global=true
x=LastJob
To this:
'Extract JobNumber from name and increment by 1, and format to five numbers
Set r=new regexp
r.pattern="[0-9]+"
r.global=true
x=Left(LastJob,5)
You're just changing one line (the last).
I don't think you need the regular expression. In fact, it sounds like that's part of your problem because in addition to finding the first 5 digits, it's finding any digits within the folder name and operating on those as well.
After you determine LastJob, just do this:
x = Left(LastJob, 5)
If IsNumeric(x) Then
nJobNumber = Right("00000" & x + 1, 5)
' Start your InputBox() prompts...
End If
r.pattern="^[0-9]+"
To avoid more changes in code, just indicate in the regexp that the pattern should be at the start of line.

How do I know when a file has been modified in a VBA Macro?

Is there a way to watch a file in VBA (which is essentially VB6), so that I know when the file has been modified? -- similar to this only I don't want to know when a file is unused, just when its modified.
The answers I've found have recommended using "FileSystemWatcher" and the Win32 API "FindFirstChangeNotification". I can't figure out how to use these though, any idea?
Okay, I put together a solution that is able to detect file system changes, in VBA (VB6).
Public objWMIService, colMonitoredEvents, objEventObject
'call this every 1 second to check for changes'
Sub WatchCheck()
On Error GoTo timeout
If objWMIService Is Nothing Then InitWatch 'one time init'
Do While True
Set objEventObject = colMonitoredEvents.NextEvent(1)
'1 msec timeout if no events'
MsgBox "got event"
Select Case objEventObject.Path_.Class
Case "__InstanceCreationEvent"
MsgBox "A new file was just created: " & _
objEventObject.TargetInstance.PartComponent
Case "__InstanceDeletionEvent"
MsgBox "A file was just deleted: " & _
objEventObject.TargetInstance.PartComponent
Case "__InstanceModificationEvent"
MsgBox "A file was just modified: " & _
objEventObject.TargetInstance.PartComponent
End Select
Loop
Exit Sub
timeout:
If Trim(Err.Source) = "SWbemEventSource" And Trim(Err.Description) = "Timed out" Then
MsgBox "no events in the last 1 sec"
Else
MsgBox "ERROR watching"
End If
End Sub
Copy and paste this sub near the above, it is called automatically if needed to initialize the global vars.
Sub InitWatch()
On Error GoTo initerr
Dim watchSecs As Integer, watchPath As String
watchSecs = 1 'look so many secs behind'
watchPath = "c:\\\\scripts" 'look for changes in this dir'
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colMonitoredEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM __InstanceOperationEvent WITHIN " & watchSecs & " WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=""c:\\\\scripts""'")
MsgBox "init done"
Exit Sub
initerr:
MsgBox "ERROR during init - " & Err.Source & " -- " & Err.Description
End Sub
You should consider using a WMI temporary event consumer to watch the file, along the lines suggested here but narrowing it down to a specific file instead of a folder
(This is assuming you can't just keep an eye on the file's Modified Date property..)
Have a look here. The page has a "Watch Directory Demo" VB sample, by Bryan Stafford.
I take it into vb6,run,display:ERROR watching.

Resources