VBScript - Delete json file in a sub-folder - vbscript

I've looked around and all examples I can find are very general purpose, I simply need code to delete a single .json file from a randomly named subfolder within the Temporary Internet Files folder.
Currently I am downloading a very small file each time my VBScript is ran, however it seems to download that file to Temp Internet Files and on each subsequent run, grabs it from there instead of the Internet. This is a file that must always be new.
How can I search through all sub-folders within Temp Internet Files and delete forge[1].json? AND, delete it's parent folder?
For dbmitch:
' DELETE CACHED FORGE FILE ------------------------ '
Function DelFiles()
look_subfolders UserProfile & "AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.IE5\"
Set Folder = objFso.GetFolder ( fold )
Sub look_subfolders ( fold )
For Each objFile in Folder.Files
If objFile.Name = "forge[1].json" Then
objFile.Delete
End If
Next
'look into subfolders:
For Each Subfolder in Folder.SubFolders
look_subfolders Subfolder.Path
Next
End Sub
End Function
Set objFso = CreateObject( "Scripting.FileSystemObject" ) is defined elsewhere at the top of the script (which has worked for every other object I've used).
I also tried this too...
Path = UserProfile & "AppData\Local\Microsoft\Windows\Temporary Internet Files\Content.IE5"
Set objFolder = objFso.GetFolder(Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
If objFile.Name = "forge[1].json" Then
objFile.Delete
End If
Next
For Each objFile In objFolder.SubFolders
If objFile.Name = "forge[1].json" Then
objFile.Delete
End if
Next
It deletes the file from the main folder, but doesn't delve into any subfolders.

Try this, it's a recursive call:
Set fs = CreateObject("Scripting.FileSystemObject")
look_subfolders "C:\windows\temp" 'change the path to your temp folder
Sub look_subfolders(fold)
Set Folder = fs.GetFolder(fold)
'folder files:
For Each objFile in Folder.Files
If objFile.Name = "forge[1].json" Then
objFile.Delete
msgbox "File found and deleted" 'message to confirm deletion
WScript Quit
End If
Next
'look into subfolders:
For Each Subfolder in Folder.SubFolders
look_subfolders Subfolder.Path
Next
End Sub

Related

How to traverse subfolders in a zip file and unzip files with specific extension?

Basically I'm trying to unzip some specific files in a zip file (there are lots of junk subfolders in it).
The thing is only the last subfolder contains files I want. Other subfolders won't contain any files except another subfolder.
Here is the code I'm currently using:
ZipFile="C:\Test.zip"
ExtractTo="C:\"
Set fso = CreateObject("Scripting.FileSystemObject")
If NOT fso.FolderExists(ExtractTo) Then
fso.CreateFolder(ExtractTo)
End If
set objShell = CreateObject("Shell.Application")
set FilesInZip= objShell.NameSpace(ZipFile).items
print "There are " & FilesInZip.Count & " files"
'Output will be 1 because there is only one subfolder there.
objShell.NameSpace(ExtractTo).CopyHere(FilesInZip)
Set fso = Nothing
Set objShell = Nothing
Is there anyway I can traverse subfolder and only unzip files with a specific extension?
You can do that with a recursive procedure that calls itself for folder items and extracts file items if they have a specific extension:
Set fso = CreateObject("Scripting.FileSystemObject")
Set app = CreateObject("Shell.Application")
Sub ExtractByExtension(fldr, ext, dst)
For Each f In fldr.Items
If f.Type = "File folder" Then
ExtractByExtension f.GetFolder, ext, dst
ElseIf LCase(fso.GetExtensionName(f.Name)) = LCase(ext) Then
app.NameSpace(dst).CopyHere f.Path
End If
Next
End Sub
ExtractByExtension app.NameSpace("C:\path\to\your.zip"), "txt", "C:\output"

VB Script to delete certain files and if files are found copy other files to directory

I have a hard drive that is infected with a virus. The virus encrypts files and then asks for a ransom to unencrypt them. The files are HELP_DECRYPT.HTML, HELP_DECRYPT.PNG, HELP_DECRYPT.TXT and HELP_DECRYPT.URL.
There are thousands of infected files on the drive. I am trying to write a script to go through all the folders on the drive, and if it finds any of the malicious files it deletes them. I then want if to copy files from the backup drive in the same directory ie. if found in I\Folder\ if would get files from F\Folder\ .
In my case the infected drive is Y, and the backup drive is X.
I am relatively new to VBScripts and here is what I have so far:
set fso = CreateObject("Scripting.FileSystemObject")
ShowSubFolders FSO.GetFolder("Y:\"), 3
Sub ShowSubFolders(Folder, Depth)
If Depth > 0 then
For Each Subfolder in Folder.SubFolders
'Wscript.Echo Subfolder.Path
DeleteFiles(subFolder.path)
On Error Resume Next
ShowSubFolders Subfolder, Depth -1
Next
End if
End Sub
'deletes the malicious files and calls the copy function'
Function DeleteFiles(path)
'wscript.echo("in delete method")
set FSO2 = Createobject("Scripting.FileSystemObject")
set ofolder = createobject("Scripting.FileSystemObject")
set ofolder = FSO2.GetFolder(path)
if FSO2.FileExists("HELP_DECRYPT.URL") Then
ofolder.DeleteFile("HELP_DECRYPT.PNG")
ofolder.DeleteFile("HELP_DECRYPT.HTML")
ofolder.DeleteFile("HELP_DECRYPT.URL")
ofolder.DeleteFile("HELP_DECRYPT.TXT")
wscript.echo("DeletedFiles")
copyFiles(FSO.GetParentFolder)
end if
End Function
'copies files from the backup'
Function CopyFiles(from)
dim to1 'where we're copying to
to1=from 'where we're copying from
Call Replace (from, "Y:", "X:")
SET FSO3 = CreateObject("Scripting.FileSystemObject")
For Each file In from 'not sure about "file"
FSO3 = file
Call FSO3.CopyFile (from, to1, true)'copies file and overwrites if already there
Next
End Function
Here's what I would use:
Option Explicit
Dim FSO, badFiles
Set FSO = CreateObject("Scripting.FileSystemObject")
badFiles = Array("HELP_DECRYPT.PNG", "HELP_DECRYPT.URL", "HELP_DECRYPT.HTML", "HELP_DECRYPT.TXT")
Walk FSO.GetFolder("Y:\")
Sub Walk(folder)
Dim subFolder
For Each subFolder in folder.SubFolders
DeleteFiles subFolder, badFiles
RestoreFiles "X:", subFolder
Walk subFolder
Next
End Sub
Sub DeleteFiles(folder, filesToDelete)
Dim file
For Each file In filesToDelete
file = FSO.BuildPath(folder.Path, file)
If FSO.FileExists(file) Then FSO.DeleteFile file, True
Next
End Sub
Sub RestoreFiles(sourceRoot, destinationFolder)
Dim sourcePath, file
WScript.Echo "Restoring " & destinationFolder.Path & " ..."
sourcePath = Replace(destinationFolder.Path, destinationFolder.Drive, sourceRoot)
If FSO.FolderExists(sourcePath) Then
For Each file In FSO.GetFolder(sourcePath).Files
WScript.Echo file.Name
' maybe add a DateLastModified check here?
file.Copy FSO.BuildPath(destinationFolder.Path, file.Name), True
Next
Else
WScript.Echo "Warning! Folder not found: " & sourcePath
End If
End Sub
General tips for working with VBScript:
Always use Option Explicit
Avoid On Error Resume Next except in very closely confined situations. Simply suppressing any errors is never a good idea.
Run scripts like the above on the command line with cscript.exe so you can see the script's Echo output without having to click at 1000's of message boxes.
Use a global FSO object. No need to define a new one in every function
Try to be generic. Look how DeleteFiles() RestoreFiles() above are actually not at all tailored to your current problem. You might be able to re-use those functions in a different script without having to change them.

VBS to Search for Multiple Files Recursively in C:\Users

I need to recursively search for multiple files through the C:\Users directory tree recursively.
If I find any of the specified files in any of the sub-directories, I want to echo out the full path.
Here is what I have:
Dim fso,folder,files,sFolder,newFolder
Dim arr1
arr1 = Array("myFile1.pdf","myFile2.pdf","myFile3.pdf","nutbag.rtf","whoa.txt")
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = "C:\Users"
Set folder = fso.GetFolder(sFolder)
Set files = folder.SubFolders
For each folderIdx In files
IF (Instr(folderIdx.Name,"Default") <> 1) Then
If (Instr(folderIdx.Name,"All Users") <> 1) Then
newFolder = sfolder & "\" & folderIdx.Name
CopyUpdater fso.GetFolder(newFolder)
End If
End If
Next
Sub CopyUpdater(fldr)
For Each f In fldr.Files
For Each i in arr1
If LCase(f.Name) = i Then
WScript.echo(f.name)
End If
Next
Next
For Each sf In fldr.SubFolders
CopyUpdater sf
Next
End Sub
If I run it as 'Administrator', I get:
VBScript runtime error: Permission Denied
If I run it as 'Local System' user, I get:
VBScript runtime error: Path not found
If I add, 'On Error Resume Next' to the beginning to suppress the errors, I get nothing back.
I have placed a text file called 'whoa.txt' in numerous locations around the C:\Users sub-dirs.
My suspicion is that it is a Windows permissions thing, but I am unsure.
Thanks much.
First I didn't use your code, it confuses me what you are trying to accomplish.
Next you should run the script in Administrator mode command prompt. This should allow you to check if the file is there.
Then paste code below to a vbs file and cscript it. This code displays all the matched filenames.My idea is that instead of going through all files in any folder for a matching filename, check if those wanted files exists in that folder - this is generally faster as some folders contains hundreds of files if not thousands (check your Temp folder!).
Option Explicit
Const sRootFolder = "C:\Users"
Dim fso
Dim arr1
Dim oDict ' Key: Full filename, Item: Filename
Main
Sub Main
arr1 = Array("myFile1.pdf", "myFile2.pdf", "myFile3.pdf", "nutbag.rtf", "whoa.txt")
Set fso = CreateObject("Scripting.FileSystemObject")
Set oDict = CreateObject("Scripting.Dictionary")
' Call Recursive Sub
FindWantedFiles(sRootFolder)
' Display All Findings from Dictionary object
DisplayFindings
Set fso = Nothing
Set oDict = Nothing
End Sub
Sub FindWantedFiles(sFolder)
On Error Resume Next
Dim oFDR, oItem
' Check if wanted files are in this folder
For Each oItem In arr1
If fso.FileExists(sFolder & "\" & oItem) Then
oDict.Add sFolder & "\" & oItem, oItem
End If
Next
' Recurse into it's sub folders
For Each oFDR In fso.GetFolder(sFolder).SubFolders
FindWantedFiles oFDR.Path
Next
End Sub
Sub DisplayFindings()
Dim oKeys, oKey
oKeys = oDict.Keys
For Each oKey In oKeys
wscript.echo oKey
Next
End Sub

copying folder to another path getting error

I have this below code which is copying files from one folder and creating a new folder if does not exist and then pasting the files over there.I am getting a path not found error..meaning if I want to create a new folder in c:\versions\myfolder it is not creating the path and throwing error..am I doing something wrong here.
Dim LastMonth
Dim strFolder
Const strFile = "C:\inetpub\wwwroot\Shared"
Const Overwrite = True
Dim oFSO
LastMonth = DateAdd("m",-1,Date)
strFolder = "C:\Versions\" & "Common_" & Replace(LastMonth,"/","-")&"/"
Set oFSO = CreateObject("Scripting.FileSystemObject")
WScript.Echo strFolder
If Not oFSO.FolderExists(strFolder) Then
oFSO.CreateFolder strFolder
End If
oFSO.CopyFolder strFile, strFolder, Overwrite
To make the question easy to understand I also tried doing this oFSO.CreateFolder("C:\Versions\Shared") but it doe snot work.
You can create folders including their parent folders by recursively traversing the path upwards until you find an existing parent folder, and then create the child folders as you descend back:
Set fso = CreateObject("Scripting.FileSystemObject")
Sub CreateSubFolder(path)
If Not fso.FolderExists(path) Then
drive = fso.GetDriveName(path)
If Not fso.DriveExists(drive) Then
WScript.Echo "Drive " & drive & " doesn't exist."
WScript.Quit 1
End If
parent = fso.GetParentFolderName(path)
If Not fso.FolderExists(parent) Then CreateSubFolder parent
fso.CreateFolder path
End If
End Sub
CreateSubFolder "C:\path\to\some\distant\sub\folder"
You can't create a folder and subfolder at the same time, the parent folder must exists before you can create the sub-folder.
You put a forward slash (/) in the folder name instead of a backslash (\) in the strFolder path. (Typo?!)
Hope that helps

Merging PDF's in multiple locations with pdftk

I'm trying to merge multiple PDF's calling pdftk from a batch or VBS script file.
The issue is that the PDF's are all located in subfolders within a common parent directory. Example: parent folder > subfolder1, subfolder2, subfolder3, where the script/BAT file is located in parent folder and each subfolder contains a PDF.
pdftk is called as follows: pdftk.exe *.pdf cat output OutputFile.pdf
This will merge only the PDF's in the current directory though, and not in the subfolders.
Is there a way to do one of the following:
Use the VBS/BAT file to copy all PDF's in the subfolders to another directory, and not error-out if some of the subfolders are empty
Have pdftk look through the subfolders to select the PDF's to merge
Any help would be appreciated.
Try this:
Wscript.Echo "begin."
Dim pdffiles
pdffiles=""
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSuperFolder = objFSO.GetFolder(WScript.Arguments(0))
Call ShowSubfolders (objSuperFolder)
Dim objShell
Set objShell = CreateObject("Shell.Application")
objShell.ShellExecute "pdftk.exe", pdffiles & " output combined.pdf", "", "runas", 1
Wscript.Echo "end."
WScript.Quit 0
Sub ShowSubFolders(fFolder)
Set objFolder = objFSO.GetFolder(fFolder.Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
If UCase(objFSO.GetExtensionName(objFile.name)) = "PDF" Then
pdffiles=pdffiles & " " & objFile.Name
End If
Next
For Each Subfolder in fFolder.SubFolders
ShowSubFolders(Subfolder)
Next
End Sub

Resources