VBScript to delete a folder - vbscript

I'm using below code to delete the folder since it is used by other application I'm getting an error:
Permission denied-Cannot delete a folder
I need a code to check if the folder is in use by other application, if so kill that process and then delete that folder.
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("C:\Users\x")
'delete all files in root folder
For Each f In folder.Files
On Error Resume Next
name = f.Name
f.Delete True
If Err Then
WScript.Echo "Error deleting:" & name & " - " & Err.Description
Else
WScript.Echo "Deleted:" & name
End If
On Error GoTo 0
Next
'delete all subfolders and files
For Each f In folder.SubFolders
On Error Resume Next
name = f.Name
f.Delete True
If Err Then
WScript.Echo "Error deleting:" & name & " - " & Err.Description
Else
WScript.Echo "Deleted:" & name
End If
On Error GoTo 0
Next

Related

VBS/BAT - Show Progress of Script Execution

I have roughly 8 scripts that need to be executed, and some of the scripts may sometimes take a while to complete the execution and all you get to see is the message box at the end of the script that says completed once everything is done..
I am looking for a way to show some form of progress/progress bar while the scripts execute, if this is even possible?
I read somewhere that it is easier/possible to show a progress bar in command line, but all my code are in vbscript files..
Currently, I have a bat file that calls and executes my scripts for me.
Here is an example of just one of my scripts that takes a while - This code looks in a specific path directory for the 3 latest csv files and then copies them to a new location:
Option Explicit
Dim FolderToCheck, FolderDestination, FileExt, mostRecent, noFiles, fso, fileList, file, filecounter, oShell, strHomeFolder
' Enumerate current user's home path - we will use that by default later if nothing specified in commandline
Set oShell = CreateObject("WScript.Shell")
'Variables -----
folderToCheck = strHomeFolder & "X:\Data\Terminations\Daily_Terminations" ' Folder Source to check for recent files to copy FROM
folderDestination = strHomeFolder & "X:\Test\Terminations" ' Destination Folder where to copy files TO
fileExt = "csv" ' Extension we are searching for
mostRecent = 3 ' Most Recent number of files to copy
' --------------
PreProcessing() ' Retrieve Command Line Parameters
' Display what we are intending on doing
'wscript.echo "Checking Source: " & FolderToCheck & "For Files of type: " & FileExt
'wscript.echo "Copying most recent file(s) to: " & FolderDestination & "."
noFiles = TRUE
Set fso = CreateObject("Scripting.FileSystemObject")
Set fileList = CreateObject("ADOR.Recordset")
fileList.Fields.append "name", 200, 255
fileList.Fields.Append "date", 7
fileList.Open
If fso.FolderExists(FolderToCheck) Then
For Each file In fso.GetFolder(FolderToCheck).files
If LCase(fso.GetExtensionName(file)) = LCase(FileExt) then
fileList.AddNew
fileList("name").Value = File.Path
fileList("date").Value = File.DateLastModified
fileList.Update
If noFiles Then noFiles = FALSE
End If
Next
If Not(noFiles) Then
'wscript.echo fileList.recordCount & " File(s) found. Sorting and copying last " & mostRecent &"..."
fileList.Sort = "date DESC"
If Not(fileList.EOF) Then
fileList.MoveFirst
If fileList.recordCount < mostRecent Then
wscript.echo "WARNING: " & mostRecent &" file(s) specified but only " & fileList.recordcount & " file(s) match criteria. Adjusted to " & fileList.RecordCount & "."
mostRecent = fileList.recordcount
End If
fileCounter = 0
Do Until fileList.EOF Or fileCounter => mostRecent
If Not(fso.FolderExists(folderDestination)) Then
wscript.echo "Destination Folder did not exist. Creating..."
fso.createFolder folderDestination
End If
fso.copyfile fileList("name"), folderDestination & "\", True
'wscript.echo fileList("date").value & vbTab & fileList("name")
fileList.moveNext
fileCounter = fileCounter + 1
Loop
wscript.echo "Files Seccuessfully Copied"
Else
wscript.echo "An unexpected error has occured."
End If
Else
wscript.echo "No matching """ & FileExt &""" files were found in """ & foldertocheck & """ to copy."
End If
Else
wscript.echo "Error: Source folder does not exist """ & foldertocheck & """."
End If
fileList.Close
Function PreProcessing
Dim source, destination, ext, recent
' Initialize some variables
Set source = Nothing
Set destination = Nothing
Set ext = Nothing
Set recent = Nothing
source = wscript.arguments.Named.Item("source")
destination = wscript.arguments.Named.Item("destination")
ext = wscript.arguments.Named.Item("ext")
recent = wscript.arguments.Named.Item("recent")
If source <> "" Then FolderToCheck = source
If destination <> "" Then FolderDestination = destination
If ext <> "" Then FileExt = ext
If recent <> "" Then mostRecent = int(recent)
End Function

Uploading folder content to FTP with VBScript gives dialog box to overwrite existing file

This is one of the first times I am using VBScript to create a task I want to run in a program called Qlikview.
What I want to do is upload all the content of one local folder to an FTP folder but when a file is already on that FTP folder it just needs to "Overwrite All" so do "Yes to All" automatically
Here is my code:
Function FTPUpload(FTPHost, FTPUser, FTPPass, FTPPath)
Set oShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
'Copy Options: 16 = Yes to All
Const copyType = 16
strFTP = "ftp://" & FTPUser & ":" & FTPPass & "#" & FTPHost
Set objFTP = oShell.NameSpace(strFTP)
'Upload all files in folder
If objFSO.FolderExists(FTPPath) Then
'Code below can be used to upload entire folder
Set objFolder = oShell.NameSpace(FTPPath)
Wscript.Echo "Uploading folder " & FTPPath & " to " & strFTP
objFTP.CopyHere objFolder.Items, copyType
End If
'If Err.Number <> 0 Then
' Wscript.Echo "Error: " & Err.Description
'End If
On Error Goto 0
End function
I use objFTP.CopyHere objFolder.Items, copyType to copy the content and copyType = 16 I found this on the internet Here where 16 stands for "Yes to All" when a dialog appears.
The problem is when I run this code, it uploads to the FTP but when a file exists I keep getting the overwrite dialog. What could be the problem?

How can I delete folder as adminstrator in windows script?

I developed an uninstaller windows script file for my application.
I'm trying to delete a folder from Programfiles (x86) but I'm getting this error
Microsoft VBScript runtime error '800A0046' Premission Denied
My code is below.
Dim shell, systempath
set shell = WScript.CreateObject( "WScript.Shell" )
systempath = shell.ExpandEnvironmentStrings("%SystemRoot%")
shell.Run Chr(34) & systempath & "\system32\msiexec.exe" & Chr(34) & " /x{ProductCode}"
For Each f In CreateObject("Scripting.FileSystemObject").GetFolder("C:\Program Files (x86)\XXXXX").SubFolders
If LCase(f.Name) <> "dev" Then
f.Delete
If Err Then
WScript.Echo "Error deleting:" & Name & " - " & Err.Description
Else
WScript.Echo "Deleted:" & Name
End If
On Error GoTo 0
End If
Next
WScript.Quit
The error line is "f.Delete".There is no problem when I ran this code on administrator account.But not an administrator I got the permission denied error.
How can I solve this problem?

Copy 1 latest extension MDB file from a source folder to destination folder for WIN 2000

I have a script whereby this will copy 2 files(ext: txt) from a source folder to destination folder based on the latest date file. I have tested with WIN 7 and Vista and it is working fine. I get the output that i wanted. When i tested with WIN 2000 with different file extension MDB file and folder path, i could not get the output. Here, i have edit to only copy 1 latest file. Please check the script below and help me :-(
Option Explicit
Dim FolderToCheck, FolderDestination, FileExt, mostRecent, noFiles, fso, fileList, file, filecounter, oShell, strHomeFolder
' Enumerate current user's home path - we will use that by default later if nothing specified in commandline
Set oShell = CreateObject("WScript.Shell")
strHomeFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%")
'Variables -----
folderToCheck = strHomeFolder & "C:\Mms2\MDB"' Folder Source to check for recent files to copy FROM
folderDestination = strHomeFolder & "C:\Documents and Settings\Mms\Desktop\Test"'Destination Folder where to copy files TO
fileExt = "MDB" ' Extension we are searching for
mostRecent = 1 ' Most Recent number of files to copy
' --------------
'PreProcessing() ' Retrieve Command Line Parameters
' Display what we are intending on doing
' wscript.echo "Checking Source: " & FolderToCheck
' wscript.echo "For Files of type: " & FileExt
' wscript.echo "Copying most recent "& mostRecent &" file(s) to: " & FolderDestination & "."
' wscript.echo
noFiles = TRUE
Set fso = CreateObject("Scripting.FileSystemObject")
Set fileList = CreateObject("ADOR.Recordset")
fileList.Fields.append "name", 200, 255
fileList.Fields.Append "date", 7
fileList.Open
If fso.FolderExists(FolderToCheck) Then
For Each file In fso.GetFolder(FolderToCheck).files
If LCase(fso.GetExtensionName(file)) = LCase(FileExt) then
fileList.AddNew
fileList("name").Value = File.Path
fileList("date").Value = File.DateLastModified
fileList.Update
If noFiles Then noFiles = FALSE
End If
Next
If Not(noFiles) Then
' wscript.echo fileList.recordCount & " File(s) found. Sorting and copying last " & mostRecent &"..."
fileList.Sort = "date DESC"
If Not(fileList.EOF) Then
fileList.MoveFirst
If fileList.recordCount < mostRecent Then
' wscript.echo "WARNING: " & mostRecent &" file(s) specified but only " & fileList.recordcount & " file(s) match criteria. Adjusted to " & fileList.RecordCount & "."
mostRecent = fileList.recordcount
End If
fileCounter = 0
Do Until fileList.EOF Or fileCounter => mostRecent
If Not(fso.FolderExists(folderDestination)) Then
' wscript.echo "Destination Folder did not exist. Creating..."
fso.createFolder folderDestination
End If
fso.copyfile fileList("name"), folderDestination & "\", True
' wscript.echo fileList("date").value & vbTab & fileList("name")
fileList.moveNext
fileCounter = fileCounter + 1
Loop
Else
' wscript.echo "An unexpected error has occured."
End If
Else
' wscript.echo "No matching """ & FileExt &""" files were found in """ & foldertocheck & """ to copy."
End If
Else
' wscript.echo "Error: Source folder does not exist """ & foldertocheck & """."
End If
fileList.Close
Function PreProcessing
Dim source, destination, ext, recent
' Initialize some variables
Set source = Nothing
Set destination = Nothing
Set ext = Nothing
Set recent = Nothing
'Get Command Line arguments
' <scriptname>.vbs /Source:"C:\somepath\somefolder" /Destination:"C:\someotherpath\somefolder" /ext:MDB /recent:1
source = wscript.arguments.Named.Item("source")
destination = wscript.arguments.Named.Item("destination")
ext = wscript.arguments.Named.Item("ext")
recent = wscript.arguments.Named.Item("recent")
If source <> "" Then FolderToCheck = source
If destination <> "" Then FolderDestination = destination
If ext <> "" Then FileExt = ext
If recent <> "" Then mostRecent = int(recent)
End Function
you'll need to change a few things:
Remove these lines - they're not required any more:
' Enumerate current user's home path - we will use that by default later if nothing specified in commandline
Set oShell = CreateObject("WScript.Shell")
strHomeFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%")
Update these lines:
'Variables -----
folderToCheck = "C:\Mms2\MDB" ' Folder Source to check for recent files to copy FROM
folderDestination = "C:\Documents and Settings\Mms\Desktop\Test" 'Destination Folder where to copy files TO

Can't stop a service using vbscript

I'm using the following code to try to stop a service. I can display the service state using WScript.Echo objService.State so I know I have the right service name and that it can find it and determine its state as running or stopped but when I run this script I get an Error on Line 51: Error Not Found Code 80041002 (see screenshot)
The line of code at 51 is:
objService.StopService()
Where am I going wrong? I can stop and start this via the command line using sc.exe and am able to control other services ie Alerter but as soon as I try to control this particular service it fails.
Thanks
EDIT The full code from the script (Thanks Brandon Moretz who pointed out
that I hadn't posted the full code so
the Line number didn't mean anything &
I have changed the StartService() back
to Stop as it originally was so now you have more to go on. Sorry!)
' 1. Check that the latest backup zip exists and store its name in LBZ (LatestBackupZip)
' 2. Stop the Livecontent Service
' 3. Remove .dbx, .lck and .log files from DataFolder
' 4. restart the service
' 5. Restore the database
Dim fileNewest
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
'Set ImportFldr = fso.GetFolder("C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data\Import")
Set ImportFldr = fso.GetFolder("C:\Program Files\XyEnterprise\SDL LiveContent\data\export")
'Set DataFldr = fso.GetFolder("C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data")
Set DataFldr = fso.GetFolder("C:\Program Files\XyEnterprise\SDL LiveContent\data")
For Each aFile In ImportFldr.Files
sExtension = fso.GetExtensionName(aFile.Name)
If sExtension = "log" Then
'Msgbox "The file extension is a " & sExtension
Else
'Msgbox "The file extension is a " & sExtension
If fileNewest = "" Then
Set fileNewest = aFile
Else
'If fileNewest.DateCreated < aFile.DateCreated Then
If CDate(fileNewest.DateCreated) < CDate(aFile.DateCreated) Then
Set fileNewest = aFile
End If
End If
End If
Next
Msgbox "The Newest File in the folder is " & fileNewest.Name & chr(13) & "Size: " & fileNewest.Size & " bytes" & chr(13) & "Was last modified on " & FileNewest.DateLastModified
' Change to /Data
'WScript.Echo WshShell.CurrentDirectory
WshShell.CurrentDirectory = DataFldr
'WScript.Echo WshShell.CurrentDirectory
' Stop the Livecontent service
strComputer = "."
Dim objService
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colServiceList = objWMIService.ExecQuery _
("Select * from Win32_Service where Name = 'LiveContent'")
For Each objService in colServiceList
WScript.Echo objService.State
If objService.State = "Running" Then
objService.StopService()
'Wscript.Sleep 5000
End If
Next
'Dim objShell
'Set objShell = CreateObject("WScript.Shell")
'objShell.Run "%comspec% /k c: & cd ""C:\Program Files (x86)\XyEnterprise\SDL LiveContent\"" & """"loaddb RESTORE -'Dlc.file=C:\PROGRA~2\XYENTE~1\SDLLIV~1\data\Import\" & fileNewest.Name & " -Dlc.pswd=N2kAs72z"""""
LATEST EDIT
I have taken your code and still can't get it to work. I noticed that the line:
Set objWMIService = GetObject("winmgmts:\" & strComputer & "\root\cimv2")
was missing a \ at "winmgmts:\" which I have added and I like your check to see if there is an (x86) directory as I am testing this on a 32bit server but will move it over to a 64 when it is ready so that will work nicely.
Also this section didn't work:
If fso.FolderExists( "C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data" ) Then
Set DataFldr= fso.GetFolder("C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data")
Else If fso.GetFolder("C:\Program diles\XyEnterprise\SDL LiveContent\data") Then
Set DataFldr= fso.GetFolder("C:\Program diles\XyEnterprise\SDL LiveContent\data")
End If
But did if I changed the ElseIf fso.GetFolder to fso.FolderExists
The script runs fine if I comment out Line 78
objService.StopService()
But as soon as I uncomment it I get an error:
Line: 78
Char: 9
Error: Not found
Code: 80041002
Source: SWbemObjectEx
But the Service can be found as the line: WScript.Echo objService.State Echos its state to the screen.
Really confuzzled now.
' 1. Check that the latest backup zip exists and store its name in LBZ (LatestBackupZip)
' 2. Stop the Livecontent Service
' 3. Remove .dbx, .lck and .log files from DataFolder
' 4. restart the service
' 5. Restore the database
Dim fileNewest
Dim ImportFldr
Dim DataFldr
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
If fso.FolderExists( "C:\Program Files\XyEnterprise\SDL LiveContent\data\Import" ) Then
Set ImportFldr = fso.GetFolder("C:\Program Files\XyEnterprise\SDL LiveContent\data\Import")
Else
WScript.Echo "Warning: Import Directory can not be found"
End If
If fso.FolderExists( "C:\Program Files\XyEnterprise\SDL LiveContent\data\export" ) Then
Set ImportFldr = fso.GetFolder("C:\Program Files\XyEnterprise\SDL LiveContent\data\export")
Else
WScript.Echo "Warning: Export Directory can not be found"
End If
If fso.FolderExists( "C:\Program Files\XyEnterprise\SDL LiveContent\data" ) Then
Set DataFldr= fso.GetFolder("C:\Program Files\XyEnterprise\SDL LiveContent\data")
Else
WScript.Echo "Warning: Data Directory can not be found"
End If
For Each aFile In ImportFldr.Files
sExtension = fso.GetExtensionName(aFile.Name)
If sExtension = "log" Then
'Msgbox "The file extension is a " & sExtension
Else
'Msgbox "The file extension is a " & sExtension
If fileNewest = "" Then
Set fileNewest = aFile
Else
If fileNewest.DateCreated < aFile.DateCreated Then
If CDate(fileNewest.DateCreated) < CDate(aFile.DateCreated) Then
Set fileNewest = aFile
End If
End If
End If
End If
Next
'Msgbox "The Newest File in the folder is " & fileNewest.Name & chr(13) & "Size: " & fileNewest.Size & " bytes" & chr(13) & "Was last modified on " & FileNewest.DateLastModified
' Change to /Data
WScript.Echo WshShell.CurrentDirectory
WshShell.CurrentDirectory = DataFldr
WScript.Echo WshShell.CurrentDirectory
' Stop the Livecontent service
strComputer = "."
Dim objService
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colServiceList = objWMIService.ExecQuery _
("Select * from Win32_Service where Name = 'LiveContent'")
For Each objService in colServiceList
WScript.Echo objService.State
If objService.State = "Running" Then
objService.StopService()
WScript.Echo objService.State
Wscript.Sleep 5000
End If
Next
EDIT 2
After very extensive testing we have come to the conclusion that there is nothing wrong with the script, it is just that this particular service will not stop with this method.
To this end we have moved on and are now using
objShell.Run "sc start LiveContent"
And this works a treat.
Thanks to Brandon for your help.
There are a couple of minor issues:
1.) Not checking for if a folder exists for calling get folder, this is what was causing your 'Not Found' error.
2.) Non-matching If ... Then & End statements in your file loop. (I would probably choose a better editor for vbscript, programmers notepad and notepad++ are very useful.)
3.) The StartService() / StopService() mix-up I mentioned previously.
' 1. Check that the latest backup zip exists and store its name in LBZ (LatestBackupZip)
' 2. Stop the Livecontent Service
' 3. Remove .dbx, .lck and .log files from DataFolder
' 4. restart the service
' 5. Restore the database
Dim fileNewest
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Dim ImportFldr
If fso.FolderExists( "C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data\Import" ) Then
Set ImportFldr = fso.GetFolder("C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data\Import")
Else If fso.FolderExists( "C:\Program Files\XyEnterprise\SDL LiveContent\data\export" ) Then
Set ImportFldr = fso.GetFolder("C:\Program Files\XyEnterprise\SDL LiveContent\data\export")
End If
Dim DataFldr
If fso.FolderExists( "C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data" ) Then
Set DataFldr= fso.GetFolder("C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data")
Else If fso.GetFolder("C:\Program diles\XyEnterprise\SDL LiveContent\data") Then
Set DataFldr= fso.GetFolder("C:\Program diles\XyEnterprise\SDL LiveContent\data")
End If
For Each aFile In ImportFldr.Files
sExtension = fso.GetExtensionName(aFile.Name)
If sExtension = "log" Then
'Msgbox "The file extension is a " & sExtension
Else
'Msgbox "The file extension is a " & sExtension
If fileNewest = "" Then
Set fileNewest = aFile
Else
If fileNewest.DateCreated < aFile.DateCreated Then
If CDate(fileNewest.DateCreated) < CDate(aFile.DateCreated) Then
Set fileNewest = aFile
End If
End If
End If
End If
Next
Msgbox "The Newest File in the folder is " & fileNewest.Name & chr(13) & "Size: " & fileNewest.Size & " bytes" & chr(13) & "Was last modified on " & FileNewest.DateLastModified
' Change to /Data
'WScript.Echo WshShell.CurrentDirectory
WshShell.CurrentDirectory = DataFldr
'WScript.Echo WshShell.CurrentDirectory
' Stop the Livecontent service
strComputer = "."
Dim objService
Set objWMIService = GetObject("winmgmts:\" & strComputer & "\root\cimv2")
Set colServiceList = objWMIService.ExecQuery _
("Select * from Win32_Service where Name = 'LiveContent'")
For Each objService in colServiceList
WScript.Echo objService.State
If objService.State = "Running" Then
objService.StopService()
'Wscript.Sleep 5000
End If
Next
'Dim objShell
'Set objShell = CreateObject("WScript.Shell")
'objShell.Run "%comspec% /k c: & cd ""C:\Program Files (x86)\XyEnterprise\SDL LiveContent\"" & """"loaddb RESTORE -'Dlc.file=C:\PROGRA~2\XYENTE~1\SDLLIV~1\data\Import\" & fileNewest.Name & " -Dlc.pswd=N2kAs72z"""""
After very extensive testing we have come to the conclusion that there is nothing wrong with the script as it starts and stops other services, it is just that this particular service will not stop with this method.
To this end we have moved on and are now using
objShell.Run "sc start LiveContent"
And this works a treat.
Thanks to Brandon for your help.

Resources