I need to develop the VBScript that donwload all files with size equals 0 from drive C. I have made following script:
Dim oFSO
Dim sDirectoryPath
Dim oFolder
Dim oFileCollection
Dim oFile
Dim oFolderCollection
Dim n
Set oFSO = CreateObject("Scripting.FileSystemObject")
sDirectoryPath = "C:\"
set oFolder = oFSO.GetFolder(sDirectoryPath)
set oFolderCollection = oFolder.SubFolders
set oFileCollection = oFolder.Files
For each oFile in oFileCollection
IF oFile.Size = 0 Then
oFile.Delete(true)
END IF
Next
But this script deletes files from root directory of drive C only! I need to use recusrive in this code, but I'm new in VBScript and don't know how I can do it. Please, I hope you will help me. Thank you.
here a tested and working script
set oFso = createobject("scripting.filesystemobject")
sDirectorypath = "c:\testing"
delete_empty_files(sDirectorypath)
sub delete_empty_files(folder)
set oFolder = oFso.getfolder(folder)
for each oFile in oFolder.files
if oFile.size = 0 then
wscript.echo " deleting " & oFile.path
oFile.delete(true)
end if
next
for each oSubFolder in oFolder.subfolders
delete_empty_files(oSubFolder)
next
end sub
Related
'I have 2 scripts but could not combine them
'create multiple folders script:
Dim objFSO, objFolder, strDirectory, i
strDirectory = "C:\Users\test\Desktop\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
i = 1 ''
While i < 150
Set objFolder = objFSO.CreateFolder(strDirectory & i)
i = i+1
''WScript.Quit ''
Wend
'desktop path script
set WshShell = WScript.CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
wscript.echo(strDesktop)
I want the code to automatically find the desktop path and then create the folders, some one help me please ?
To get the desktop folder path string and create a sub directory you can do this:
Set objShell = Wscript.CreateObject("Wscript.Shell")
strPath = objShell.SpecialFolders("Desktop")
Dim objFso
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")
If Not objFso.FolderExists(strPath + "\NewFolder") Then
objFso.CreateFolder strPath + "\NewFolder"
I tried to combine a couple different scripts, which works fine until I change the path of strPath. The moment I change it to anything else I get an error message
Invalid Procedure call or argument.
The script is meant to find the latest file in any directory (including subfolders), and copy and paste the file into a folder
Dim strPath, oFSO, oFile, oFolder, dteDate, strName, N
strPath = "C:\Users\parjo16\Documents\Archived"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(strPath)
For Each oFile In oFolder.Files
If oFile.DateLastModified > dteDate Then
dteDate = oFile.DateLastModified
strName = oFile.Name
End If
N = N + 1
Next 'oFile
Call FindTheSubFolderFiles(oFolder, N, dteDate, strNme)
Const strfolder = "C:\SalaryData\"
Const Overwrite = True
Dim oFSOd
Set oFSOd = CreateObject("Scripting.FileSystemObject")
If Not oFSOd.FolderExists(strfolder) Then
oFSOd.CreateFolder strfolder
End If
oFSOd.CopyFile strNme, strfolder & "salaries.xlsx", Overwrite
Set oFSOd = Nothing
Set oFSO = Nothing
Set oFile = Nothing
Set oFolder = Nothing
Function FindTheSubFolderFiles(ByRef oParentFolder, ByRef lngR, ByRef dteDte, ByRef strNme)
Dim oSubFolder
Dim oFile
For Each oSubFolder In oParentFolder.SubFolders
For Each oFile In oSubFolder.Files
If oFile.DateLastModified > dteDte Then
dteDte = oFile.DateLastModified
strNme = oFile.Path
End If
lngR = lngR + 1
Next
FindTheSubFolderFiles oSubFolder, lngR, dteDte, strNme
Next 'oSubFolder
Set oSubFolder = Nothing
Set oFile = Nothing
End Function
Looks like the script was doing two checks, one for the main folder, one for the subfolder. If the result is the other, then it comes back blank.
This seems to be working now:
Function FindTheSubFolderFiles(ByRef oParentFolder, ByRef lngR, ByRef dteDte, ByRef strNme)
Dim oSubFolder
Dim oFile
For Each oSubFolder In oParentFolder.SubFolders
For Each oFile In oSubFolder.Files
If oFile.DateLastModified > dteDte Then
dteDte = oFile.DateLastModified
strNme = oFile.path
End If
lngR = lngR + 1
Next
FindTheSubFolderFiles oSubFolder, lngR, dteDte, strNme
Next 'oSubFolder
Set oSubFolder = Nothing
Set oFile = Nothing
End Function
Dim strPath, oFSO, oFile, oFolder, dteDate, strName, N
strPath = "C:\Users\parjo16\Documents\Archived\"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(strPath)
For Each oFile In oFolder.Files
If oFile.DateLastModified > dteDate Then
dteDate = oFile.DateLastModified
strName = oFile.Name
End If
N = N + 1
Next 'oFile
Call FindTheSubFolderFiles(oFolder, N, dteDate, strNme)
Const strfolder = "C:\SalaryData\"
Const Overwrite = True
Dim oFSOd
Set oFSOd = CreateObject("Scripting.FileSystemObject")
If Not oFSOd.FolderExists(strfolder) Then
oFSOd.CreateFolder strfolder
End If
On Error Resume Next
oFSOd.CopyFile strPath & strName, strfolder & "salaries.xlsx", Overwrite
oFSOd.CopyFile strNme, strfolder & "salaries.xlsx", Overwrite
Set oFSOd = Nothing
Set oFSO = Nothing
Set oFile = Nothing
Set oFolder = Nothing
I found some similar threads but they didn't solve the full problem i'm having, first, i'm a complete amatour when it comes to VBS, so i'm sorry if this is a simple problem.
I need to build a vbscript that transfers the oldest file from folder A to B every 2 minutes, this is what i come up with:
Dim colFiles
Dim strStartFolder
Dim strDestinationfolder
Dim oOldestFile
Dim oFile
Dim oFSO
strStartFolder = "C:\Users\lucas\Desktop\a\"
strDestinationfolder = "C:\Users\lucas\Desktop\b\"
I=0
Do While I=0
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set colFiles = oFSO.GetFolder(strStartFolder).Files
If colFiles.Count <= 1 Then
WScript.Quit
End If
For Each oFile In colFiles
If Not IsObject(oOldestFile) Then
Set oOldestFile = oFile
Else
If oFile.DateLastModified < oOldestFile.DateLastModified Then
Set oOldestFile = oFile
End If
End If
Next
Do While i=0
oOldestFile.Move strDestinationfolder & "\" & oOldestFile.Name
Wscript.Sleep (2000)
Loop
At the moment, the vbscript only tranfer the oldest file one time.
Can someone please help me with this ?
Thank you !
EDIT:
after the suggestions made by Hackoo and GJKH, the script looks like this :
Option Explicit
Dim colFiles
Dim strStartFolder
Dim strDestinationfolder
Dim oOldestFile
Dim oFile
Dim oFSO
strStartFolder = "C:\Users\lucas\Desktop\a\"
strDestinationfolder = "C:\Users\lucas\Desktop\b\"
Do
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set colFiles = oFSO.GetFolder(strStartFolder).Files
Wscript.echo colFiles.Count
For Each oFile In colFiles
If Not IsObject(oOldestFile) Then
Set oOldestFile = oFile
Else
If oFile.DateLastModified < oOldestFile.DateLastModified Then
Set oOldestFile = oFile
End If
End If
Next
oOldestFile.Move strDestinationfolder & "\" & oOldestFile.Name
' Pause 1 ' sleep for 2 minutes
Set oFSO = nothing
Set colFiles = nothing
Loop
'****************************************************************
Sub Pause(min)
wscript.sleep(min * 60 * 1000)
End Sub
'****************************************************************
He transfer the first file and than loops ( activated ECHO ) but he does not transfer any more files after the first one, any ideas ?
I know more about vb.net than vbs but a couple of things strike me as odd that may be causing problems here...
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set colFiles = oFSO.GetFolder(strStartFolder).Files
I would destroy these and recreate them each time it loops, in vb.net you would just set oFSO = nothing and colFiles = nothing, I'm sure the syntax is similar in vbscript.
If colFiles.Count <= 1 Then
WScript.Quit
I take it there is more than one file in the folder after you move the oldest one - because if not then script exits here.
Wscript.Sleep (2000)
This method parameter is in milliseconds, if you want to update every 2 minutes this will need to be Wscript.Sleep(120000), setting it to 2000 would be every 2 seconds.
Try like that :
Option Explicit
Dim colFiles
Dim strStartFolder
Dim strDestinationfolder
Dim oOldestFile
Dim oFile
Dim oFSO
strStartFolder = "C:\Users\lucas\Desktop\a\"
strDestinationfolder = "C:\Users\lucas\Desktop\b\"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set colFiles = oFSO.GetFolder(strStartFolder).Files
'Wscript.echo colFiles.Count
Do
'Wscript.echo colFiles.Count
If colFiles.Count <= 1 Then
'Wscript.echo colFiles.Count
WScript.Quit
End If
For Each oFile In colFiles
If Not IsObject(oOldestFile) Then
Set oOldestFile = oFile
Else
If oFile.DateLastModified < oOldestFile.DateLastModified Then
Set oOldestFile = oFile
End If
End If
Next
oOldestFile.Move strDestinationfolder & "\" & oOldestFile.Name
Pause 2 ' sleep for 2 minutes
Loop
'****************************************************************
Sub Pause(min)
wscript.sleep(min * 60 * 1000)
End Sub
'****************************************************************
I have been given a task of creating a script that takes a log file (date is in the filename), pulls the data and posts it in event manager. I have a script that works as it should I know the script is ugly so please be gentle. I'm looking for 2 things.
some days nothing has happened and no log for the day was created. when this happens my script causes all kinds of slowness in the PC. I need help with a way for the script to not do its task if no new file has been added to the logs folder.
I would like a little help cleaning up the script.
Like i said i'm very new to this and i used scripts found on the web and fit them to do what i needed them to do.
any help would be greatly appricated.
Option Explicit
Const ForReading = 1
Dim strfolder
Dim FSO
Dim FLD
Dim fil
Dim strOldName
Dim strNewName
Dim strFileParts
Dim objShell
Dim objFSO
Dim objFolder
Dim strFileName
Dim objFile
Dim objTextFile
Dim strNextLine
Dim arrServiceList
Dim i
strFolder = "C:\Logs\"
Set objShell = CreateObject ("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(strFolder)
Set objShell = CreateObject ("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile ("C:\Logs\logCatchAll.log", ForReading)
For Each strFileName in objFolder.Items
If len(objFSO.GetExtensionName(strFileName)) > 0 Then
Set objFile = objFSO.GetFile(strFolder & strFileName.Name)
If DateDiff("H",objFile.DateLastModified,Now()) > 24 Then
objFSO.DeleteFile(strFolder & strFileName.Name),True
End If
End If
next
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FLD = FSO.GetFolder(strfolder)
For Each fil in FLD.Files
strOldName = fil.Path
If InStr(strOldName, "-") > 0 Then
strFileParts = Split(strOldName, "-")
strNewName = strFileParts(0) & ".log"
FSO.MoveFile strOldName, strNewName
End If
Next
Set FLD = Nothing
Set FSO = Nothing
Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.Readline
arrServiceList = Split(strNextLine , ",")
For i = 3 to Ubound(arrServiceList)
objshell.LogEvent 4, arrServiceList(i)
Loop
You can block your Dim'd variables
You are reactivating the objShell to many times
You have a for loop at the bottom of your code without a Next statement.
You don't need to iterate through the log file until it reaches AtEndOfStream, just store it in a variable first.
You can use the same objFSO more than once if your not resetting the object.
You need to include error handling so you know where your code breaks.
Revised code.
Option Explicit
'Handle errors manually.
On Error Resume Next
'Set Constants
Const ForReading = 1
'Set Strings
Dim strFolder, strOldName, strNewName, strFileName, strFileParts, strNextLine, TFStrings
strFolder = "C:\Logs\"
'Set Objects
Dim objShell, objFSO, objFolder, objFile, objTextFile
Set objShell = CreateObject ("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objShell.Namespace(strFolder)
TFStrings = split(objFSO.OpenTextFile("C:\Logs\logCatchAll.log", ForReading).ReadAll, vbcrlf)
'Set Other Variables
Dim FLD, fil, arrServiceList, i, executed
executed = false
'Delete file procedure...
For Each strFileName in objFolder.Items
If len(objFSO.GetExtensionName(strFileName)) > 0 Then
Set objFile = objFSO.GetFile(strFolder & strFileName.Name)
If DateDiff("H",objFile.DateLastModified,Now()) > 24 Then
objFSO.DeleteFile(strFolder & strFileName.Name),True
executed = true
End If
End If
Next
If executed then
If err.number <> 0 then
'File was found, but delete was unsuccessful, log failure of delete.
executed = false
err.clear
Else
'Delete file procedure executed successfully. Lets move on.
executed = false
End If
Else
'No file was found within the conditions. log failure of search.
End if
'Move file and rename procedure...
Set FLD = objFSO.GetFolder(strfolder)
For Each fil in FLD.Files
strOldName = fil.Path
If InStr(strOldName, "-") > 0 Then
strFileParts = Split(strOldName, "-")
strNewName = strFileParts(0) & ".log"
objFSO.MoveFile strOldName, strNewName
executed = true
End If
Next
Set FLD = Nothing
Set FSO = Nothing
If executed then
If err.number <> 0 then
'File was found, but move was unsuccessful, log failure of move.
executed = false
err.clear
Else
'Move file procedure executed successfully. Lets move on.
executed = false
End If
Else
'No file was found within the conditions. log failure of search.
End if
For Each line in TFStrings
strNextLine = line
arrServiceList = Split(strNextLine , ",")
For i = 3 to Ubound(arrServiceList)
objshell.LogEvent 4, arrServiceList(i)
Next
Next
I am trying to find a specific file on computer and delete it.
This is my code:
Const DeleteReadOnly = True
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oWshShell = CreateObject("WScript.Shell")
sDir = oWshShell.ExpandEnvironmentStrings("%temp%\dir.txt")
sFileName = "\date.vbs"
If oFSO.FileExists(sDir) Then oFSO.DeleteFile(sDir)
For Each oDrive In oFSO.Drives
if oDrive.DriveType = 2 Then Search oDrive.DriveLetter
Next
Set oFile = oFSO.OpenTextFile(sDir, 1)
aNames = Split(oFile.ReadAll, VbCrLf)
oFile.Close
For Each sName In aNames
If InStr(1, sName, sFileName, 1) > 0 Then WScript.Echo sName
Next
dim filesys
Set filesys = CreateObject("Scripting.FileSystemObject")
filesys.CreateTextFile "\date.vbs", True
If filesys.FileExists("\date.vbs") Then
filesys.DeleteFile "\date.vbs"
Wscript.Echo("File deleted")
End If
Sub Search(sDrive)
WScript.Echo "Scanning drive " & sDrive & ":"
oWshShell.Run "cmd /c dir /s /b " & sDrive & ":\" & sName & " >>" & sDir, 0, True
End Sub
The code is working only partially. When the file "date.vbs" is in root folder (C:\date.vbs) then it is deleted but when it is in folder (C:\backup\date.vbs) then it will not be deleted. Do you know which code changes I should make to be able to delete file even when it is not in root but anywhere in computer?
Thank you! V.
UPDATE:
The code is pretty much working right now. I just have a final problem of deleting the file. I am able to change the attributes from Read-only to normal but still i get the error of access denied.
This is my code:
Const DeleteReadOnly = True
Dim oFSO, oDrive, sFileName, ws, WshS, fso, usrProfile, oFolder, skypefolder
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFileName = "Skype.exe"
Set WshS = WScript.CreateObject("WScript.Shell")
usrProfile = WshS.ExpandEnvironmentStrings("%UserProfile%")
skypefolder = "C:\Program Files (x86)\Skype\"
For Each oDrive In oFSO.Drives
If oDrive.DriveType = 2 Then Recurse oFSO.GetFolder(skypefolder)
Next
Sub Recurse(oFolder)
Set oFile = CreateObject("Scripting.FileSystemObject")
Dim oSubFolder, oFile
If IsAccessible(oFolder) Then
For Each oSubFolder In oFolder.SubFolders
Recurse oSubFolder
Next
WScript.Echo oFolder.Path
For Each oFile In oFolder.Files
If oFile.Name = sFileName And oFile.Attributes And 1 Then
oFile.Attributes = 0
oFile.Delete True
End If
Next
End If
End Sub
Function IsAccessible(oFolder)
On Error Resume Next
IsAccessible = oFolder.SubFolders.Count >= 0
End Function
Thank you for help!
Code I use to run the script as ADMIN. After this it started to show the MessageBoxes. Before it was running in a console.
If WScript.Arguments.Named.Exists("elevated") = False Then
CreateObject("Shell.Application").ShellExecute "wscript.exe", """" & WScript.ScriptFullName & """ /elevated", "", "runas", 1
WScript.Quit
Else
Set oShell = CreateObject("WScript.Shell")
oShell.CurrentDirectory = CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName)
'WScript.Echo("Now running with elevated permissions")
End If
So I believe there is something wrong in this code.
Your approach is much too complicated. Use a simple recursive function:
Option Explicit
Const DeleteReadOnly = True
Dim oFSO, oDrive, sFileName
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFileName = "date.vbs"
For Each oDrive In oFSO.Drives
If oDrive.DriveType = 2 Then Recurse oDrive.RootFolder
Next
Sub Recurse(oFolder)
Dim oSubFolder, oFile
If IsAccessible(oFolder) Then
For Each oSubFolder In oFolder.SubFolders
Recurse oSubFolder
Next
For Each oFile In oFolder.Files
If oFile.Name = sFileName Then
'oFile.Delete ' or whatever
End If
Next
End If
End Sub
Function IsAccessible(oFolder)
On Error Resume Next
IsAccessible = oFolder.SubFolders.Count >= 0
End Function
To achieve case-insensitive file name comparison, you could use
If StrComp(oFile.Name, sFileName, vbTextCompare) = 0 Then
As an exercise: You can also use the WMI Service to find certain files. You don't have to go through all folders, you just query the file on any drive, on any folder:
Function find_file(filename)
Dim objWMIService, colItems, objItem, strComputer
strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM CIM_DataFile WHERE FileName='" & filename & "'",,48)
For Each objItem in colItems
msgbox "Found " & objItem.Name & " in " objItem.Path
Next
End Function
Note: It can take long before the function has returned its results.