vbs error-trapping on folder-listing - vbscript

I'm making a script to list all files within a folder.
The intention is to list all files within a specific folder on every server we have.
So I have an excel file with as first line every servername.
Of course I don't have rights on every server or there is no scripts folder; so sometimes i get a "path not found" error.
Eventhough I used On Error Resume Next it still throws the error.
I would need something like try - catch, but that doens't exists in vbs.
How can I try to connect to folders and ignore when there's an error?
The offending lines is the Set folder = ...
Do While objSheet.Cells(1, intCol).Value <> ""
intRow = 2
sFolder ="\\" & objSheet.Cells(1, intCol).Value & "\C$\Scripts"
'msgbox sFolder
Set folder = fso.GetFolder(sFolder)
Set files = folder.Files
...
The full code: https://gist.github.com/076501c940e8388b5b39

You can check if a folder exists with fso.FolderExists(sFolder):
If fso.FolderExists(sFolder) then
Set folder = fso.GetFolder(sFolder)
Set files = folder.Files
For each file In files
'msgbox file.name
objSheet.Cells(intRow, intCol).Value = file.Name
introw = introw + 1
Next
objExcel.ActiveWorkbook.Save
intCol = intcol+1
End if

Related

VBScript - Delete json file in a sub-folder

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

Overwrite files when user open files with write access

I am writing a VBScript to copy file from source to target. It works copy from source to target but if we are trying to overwrite the file to target and if any user open that same file in target it's not overwriting it.
Note: the user open the file has write access.
Could someone please help on this? Below is the function but have to delete file that are also open in destination.
Sub Clear_All_Files_And_SubFolders_In_Folder()
'Delete all files and subfolders
'Be sure that no file is open in the folder
Dim FSO As Object
Dim MyPath As String
Set FSO = CreateObject("scripting.filesystemobject")
MyPath = "C:\Users\Ron\Test" '<< Change
If Right(MyPath, 1) = "\" Then
MyPath = Left(MyPath, Len(MyPath) - 1)
End If
If FSO.FolderExists(MyPath) = False Then
MsgBox MyPath & " doesn't exist"
Exit Sub
End If
On Error Resume Next
'Delete files
FSO.DeleteFile MyPath & "\*.*", True
'Delete subfolders
FSO.DeleteFolder MyPath & "\*.*", True
On Error GoTo 0
End Sub

Duplicating a complex folder structure with only shortcuts

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.

Beginner VBscript: script that zips log files

I am having a problem with my script not actually producing a zip file. When I test the script with the paths set to something like this:
C:\Users\Bob\Desktop\Folder1\Folder2
with the test log files in folder 1 being deleted if older than 7 days, and being zipped and moved to folder 2, it will run perfectly fine. It will produce the zipped file with all of the log files in it and have the proper naming set.
So I know that at least the logic of the script works for that.
My problem is that I need this script to go through the security logs on a machine and delete any older than 7 days, and then zip up any that are left and be sent to a mounted shared drive. When I change the path to something like:
C:\Windows\System32\Config (where the logs are located)
it will still delete any log files older than 7 days, but it does not produce a zip file with any that are left. It just does nothing even though the script produces no errors. I've been trying to figure this out with no luck going over my code. If anyone could take a look over what I've had and let me know where I've gone astray that would be extremely helpful.
Thank you in advance, the script is found below.
'READ FIRST
'------------------------------------------------------------------------------------------
'Lines 14-53 delete any log files older than 7 days. Changing the value in "iDaysOld =" will change the time frame in which files are kept or deleted.
'If files do not need to be deleted this part of the script can be taken out and the Archive/Move ability will still be intact
'Lines 57-102 contain the ability to Zip your log files and send them to a new folder. The zipped file is named after the localhost and a date/timestamp is appended to the file name.
'------------------------------------------------------------------------------------------
Option Explicit
Dim oFSO, oFolder, sDirectoryPath
Dim oFileCollection, oFile, sDir
Dim iDaysOld
' Specify Directory Path From Where You want to clear the old files
sDirectoryPath = "C:\Windows\System32\config"
' Specify Number of Days Old File to Delete
iDaysOld = 7
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sDirectoryPath)
Set oFileCollection = oFolder.Files
For each oFile in oFileCollection
'Specify the Extension of file that you want to delete
'and the number with Number of character in the file extension
If LCase(oFSO.GetExtensionName(oFile.Name)) = "log" Then
If oFile.DateLastModified < (Date() - iDaysOld) Then
oFile.Delete(True)
End If
End If
Next
Set oFSO = Nothing
Set oFolder = Nothing
Set oFileCollection = Nothing
Set oFile = Nothing
WScript.Echo "Press to start zipping log files."
Dim objFile, objPath, objFolder, Command, PathLogs, RetVal
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objShell: Set objShell = CreateObject("WScript.Shell")
Dim d : d = Date()
Dim dateStr : dateStr = Year(d) & "-" & Right("00" & Month(d), 2) & "-" & Right("00" & Day(d), 2)
Dim t : t = Time()
Dim timeStr: timeStr = Hour(t) & "-" & Right("00" & Minute(t), 2) & "-" & Right("00" & Second(t), 2)
'Path where logs are located
PathLogs = "C:\Windows\System32\config"
'Loop through the logs and zip
Set objPath = objFSO.GetFolder(PathLogs)
For Each objFile In objPath.Files
If (LCase(objFSO.GetExtensionName(objFile)) = "log") Then
' zip files
Command = """C:\Program Files\7-zip\7z.exe"" a " & PathLogs & "%computername%" & "-" & dateStr & "-" & timeStr & ".zip " & PathLogs & objFile.Name
RetVal = objShell.Run(Command,0,true)
End If
Next
WScript.Echo "Zip Successful."
WScript.Echo "Now Moving Zipped Files into Archived Folder"
'move files
Set objFSO = CreateObject("Scripting.FilesystemObject")
objFSO.MoveFile "C:\Windows\System32\config\*.zip" , "C:\Testscripts\testfolder\Archived"
WScript.Echo "Move Successful."
I'd probably try echoing out the 7zip command line, checking that it looks right and running it manually from the same location as the script runs from. It might look wrong when you see it or 7zip might give you a message to indicate what's going on.

VBS script 'Path not found' error when setting file system folder object reference

I am writing a script to determine the combined size of all instances of a particular subfolder within the profile folder of each user who has logged onto a Windows 2003 server, e.g. all users' desktop folders or all users' local settings folders.
Option Explicit
Dim colSubfolders, intCount, intCombinedSize, objFolder2, objFSO1, objFSO2, objUserFolder, strOutput, objSearchFolder, objSubfolder, strSearchFolder, strSubfolderPath
intCount = 0
intCombinedSize = 0
strSearchFolder = "C:\Documents and Settings\"
Set objFSO1 = CreateObject("Scripting.FileSystemObject")
Set objSearchFolder = objFSO1.GetFolder(strSearchFolder)
Set colSubfolders = objSearchFolder.SubFolders
For Each objUserFolder in colSubfolders
strSubfolderPath = objUserFolder.Path & "\Desktop\"
Set objFSO2 = CreateObject("Scripting.FileSystemObject")
Set objSubfolder = objFSO2.GetFolder(strSubfolderPath)
intCount = intCount + 1
intCombinedSize = intCombinedSize + objSubfolder.Size
Next
MsgBox "Combined size of " & CStr(intCount) & " folders: " & CStr(intCombinedSize / 1048576) & " MB"
This code throws a 'Path not found' error (Code 800A004C) at line 15:
Set objSubfolder = objFSO2.GetFolder(strSubfolderPath)
If I print out strSubfolderPath, however, I find that all the strings returned are valid directory paths, so I don't understand why I'm getting this error.
I've tried with and without the trailing backslash at the end of the path and I've tried with 8.3 style paths to remove spaces but to no effect.
When I run your code I get the same error.
Upon further inspection, on my computer there is a folder named C:\Documents and Settings\machinename, where machinename is the name of my computer. This folder only contains one subfolder named ASPNet.
I'm guessing you have something similar.
To minimize multiple-backslash confusion, use the FileSystemObject methods consistently instead of relying on string concatenation:
strSubfolderPath = objFSO1.BuildPath(objUserFolder.Path,"Desktop")

Resources