There are 2 shared drives. One of them has a very complex folder structure. I would like to replicate the entire folder structure of Share 1 to Share 2. However I don't want to make duplicate files, rather I would want a shortcut or symbolic links to be present in the 2nd share. I tried to do this with existing tools like Robocopy and mklink and failed to achieve the result. Any Ideas to resolve this issue is highly appreciated.
You can do achieve this by Using the filesystemobject to work it's way down the folder structure, if the folder exists in the destination, do nothing and create shortcuts in that folder for all the hosting folders files. Otherwise, create the folder and create the shortcuts for the hosting files anyway.
The DoFolder sub widdles it's way down through all the subfolders.
The GetFN Function collects only the filenames of all the files in the hosting folder. Even if there are periods in the filename.
This was a fun program to write, thanks.
FolderShadows.vbs
Dim fso, HostFolder, DestFolder
'Host Folder - Folder must exist.
HostFolder = "C:\From\Folder"
'Destination Folder - Folder must exist.
DestFolder = "D:\To\Folder"
Set fso = CreateObject("Scripting.FileSystemObject")
DoFolder fso.GetFolder(HostFolder)
Sub DoFolder(Folder)
Dim SubFolder
If fso.folderexists(Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder)) = False Then
fso.createfolder(Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder))
End If
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each File In Folder.Files
Dim FileName, shortcut
If (fso.fileexists(Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder) & "\" & GetFN(File.Name) & ".lnk") = False) Then
FileName = Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder) & "\" & GetFN(File.Name) & ".lnk"
Set shortcut = CreateObject("WScript.Shell").CreateShortcut(FileName)
shortcut.Description = "Shortcut To " & File.Name
shortcut.TargetPath = fso.GetAbsolutePathName(Folder) & "\" & File.Name
shortcut.Save
End If
Next
End Sub
Function GetFN(FileName)
Dim Result, i
Result = FileName
i = InStrRev(FileName, ".")
If ( i > 0 ) Then
Result = Mid(FileName, 1, i - 1)
End If
GetFN = Result
End Function
Note: This script can run on an automated schedule, as it is built to auto update the shortcuts and folders if new files/folders are found.
Related
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
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.
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
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
i have a directory with subfolders. These subfolders have subfolders as well. For all Folders exist a timestamp with the time when they were last modified.
For example:
Folder1(21.01.2010)
-subfolder1(22.01.2010)
-subfolder2(23.01.2010)
--subfolder1(24.01.2010)
--subfolder2(25.01.2010)
Folder2(26.01.2010)
-subfolder 1(27.01.2010)
What I need is a script that checks the latest "date modified".
So the Output should be "27.01.2010".
I dont know how to start... is there a function which can list all folders??
Maybe you can help me... thank you in advance!
To get a list of folders and modified dates
Sub GetLastModified(folderspec)
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.SubFolders
For Each f1 in fc
s = s & f1.Name
s = s & f1.DateLastModified
s = s & vbCrLf
Next
MsgBox s
End Sub
Then you just need to iterate to find all folders WITHIN those folders and keep a record of the latest modified date
keep the template:
dim fs, foldercollection ,filecollection, folders, files
Set fs=CreateObject("Scripting.FileSystemObject")
Set fileobject = fs.GetFolder("c:\")
Set foldercollection = fileobject.SubFolders
folders = ""
files = ""
For Each folder in foldercollection
folders = folders & folder.name & Chr(13)
Next
Set foldercollection=nothing
Set filecollection = fileobject.Files
For Each file in filecollection
files = files & file.name & Chr(13)
next
MsgBox folders & files