VBscript to delete subfolders - vbscript

I am very new to vb script and i need a script to delete couple of thrid level subfolders based on starting name _SA and 2 days old
example
C:\abc\user1\temp\ _SA123
c:\abc\user2\temp_SA2345
c:\abc\user3\temp_SA4567
I want to delete the folder starting with _SA older than 2 days and I have 50+ users folder. please hlep
Thanks,
Chilli

Based upon the example data, this should work though I'd consider this the 4th level:
Edit: Because you asked nicely, I updated this to build a log in a variable that will list the path of the folder deleted, the date it was created, and the date you deleted it. This information shows up in a msgbox, but you could easily modify to print the data to a file instead.
Dim rootFolder
Dim fld
Dim subFld
Dim subsubFld
Dim Log
Set fso = CreateObject("Scripting.FileSystemObject")
Set rootFolder = fso.GetFolder("C:\abc\")
For Each fld In rootFolder.SubFolders
For Each subFld In fld.SubFolders
For Each subsubFld In subFld.SubFolders
If Len(subsubFld.Name) >= 3 Then
If Left(subsubFld.Name, 3) = "_SA" And subsubFld.DateCreated < Now() - 2 Then
Log = subsubFld.Path & ", Created " & subsubFld.DateCreated & ",Deleted" & Now & vbNewLine
subsubFld.Delete
End If
End If
Next
Next
Next
MsgBox Log
'Or you could print the log to a file.
It has no error trapping, (other than making sure the folder name is atleast 3 characters long) and will get permission denied if you don't have permission.
Note: the code I posted has indentations, it's just not display for some reason. If you want to see the indented code, hit the edit button.

Related

Exporting the SAS Project Log file

I used to run 3 SAS EG Projects on a daily basis. Since a couple of days, we have a "SAS Scheduler" that is basically running those latter during the night (the first one at 00:00 AM, second one at 01:00 AM, third one at 03:00 AM). Each SAS Project has multiple SAS Programs.
All in all, that is great news, but this also mean I can't check the logs directly anymore.
To keep track of the night jobs, I am trying to find what could be the best way to export the log files for each project. I found out about the SAS Project Log recently, which basically summarize the logs from all the programs within a SAS Project.
I discovered CaseySmith's answer on the SAS Community forum, basically tweaking the .vbs script to save the SAS Project log file to a .txt using the following code:
Set objProjectLog = objProject.ProjectLog
objProjectLog.Clear()
objProjectLog.Enabled = True
'strProjectLog = objProjectLog.Text
objProjectLog.SaveAs "c:\temp\projectLog.txt"
But, 1) It is a .txt file not a log file and 2) I don't know where to add it in my current .vbs script:
Option Explicit
Dim app
Call dowork
'shut down the app
If not (app Is Nothing) Then
app.Quit
Set app = Nothing
End If
Sub dowork()
On Error Resume Next
'----
' Start up Enterprise Guide using the project name
'----
Dim prjName
Dim prjObject
prjName = "C:\Users\kermit\Desktop\Project.egp" 'Project Name
Set app = CreateObject("SASEGObjectModel.Application.8.1")
If Checkerror("CreateObject") = True Then
Exit Sub
End If
'-----
' open the project
'-----
Set prjObject = app.Open(prjName,"")
If Checkerror("app.Open") = True Then
Exit Sub
End If
'-----
' run the project
'-----
prjObject.run
If Checkerror("Project.run") = True Then
Exit Sub
End If
'-----
' Save the new project
'-----
prjObject.Save
If Checkerror("Project.Save") = True Then
Exit Sub
End If
'-----
' Close the project
'-----
prjObject.Close
If Checkerror("Project.Close") = True Then
Exit Sub
End If
End Sub
Function Checkerror(fnName)
Checkerror = False
Dim strmsg
Dim errNum
If Err.Number <> 0 Then
strmsg = "Error #" & Hex(Err.Number) & vbCrLf & "In Function " & fnName & vbCrLf & Err.Description
'MsgBox strmsg 'Uncomment this line if you want to be notified via MessageBox of Errors in the script.
Checkerror = True
End If
End Function
In the end, what I would like is that on the morning, I run a program that scan the 3 project log files for Notes, Warning and Errors and send to myself an email with the results. Hence, is there a way to export the SAS Project Log (not manually) in a folder?
So, first, what is this code doing?
Set objProjectLog = objProject.ProjectLog
objProjectLog.Clear()
This clears the project log. This needs to be done before your project is run - otherwise the log contains data from past runs. So put this before the prjOBject.Run().
objProjectLog.Enabled = True
'strProjectLog = objProjectLog.Text
objProjectLog.SaveAs "c:\temp\projectLog.txt"
This then exports the project log to a text file. You of course can call that text file whatever you want. You need this code to appear after your program runs, and somewhere before it closes. Right after PrjObject.Run() is probably fine.
You will need to update the names to match your vbs file's names - they use objproject and your vbs uses prjObject, but those are the same thing, just match the names.
Second - what else could you do? If VBS isn't your thing, you have a lot of other ways you could do this.
Export your EG project to a .sas file, then schedule this in base SAS with the normal output options. This may also be possible via the scheduling interface.
Use PROC PRINTTO to redirect your log inside your SAS code.
Copy your EG project to a location you can see. The EG project does contain the log of everything that was run - so there's no reason you couldn't just open the .egp and look at it, just make sure you're not doing that with the production file since you might forget to close out.
My preference is not to schedule EG projects, but to schedule .sas programs; use EG as the development environment and then export to .sas. This gives you more flexibility. But there are a lot of different ways to skin this cat.

VBScript does not oFS.FileExists a file in oFS.CreateFolder

I'm having a strange problem with VBScript. I'd like to implement some other code with a following test:
If there is a file named like [that] in the [folder], do not copy it into the [folder].
Thing is, I found a strange relation in oFS.FileExists, I'm able to use it in a manually created folder, as long as I manually copy and paste a file into it. Then oFS.FileExists works like a charm.
Dim oFS
Set oFS = CreateObject("Scripting.FileSystemObject")
filestr = "C:\where\file\is\file.file"
If (oFS.FileExists(filestr)) Then
WScript.Echo("File exists!")
WScript.Quit()
Else
WScript.Echo("File does not exist!")
End If
But it's not exactly my point. I'd like to test if a file is already in the desired folder, and such folder will be generated automatically with oFS.CreateFolder. But when it comes to testing an automatically generated folder, it's a different story.
Dim oFS
Set oFS = CreateObject("Scripting.FileSystemObject")
oFS.CreateFolder(destination & objFoldername)
Initially I thought it might be something wrong with the file I'm looking for. I moved it to some other place and the oFS.FileExists found it. So I figured it might be the case of the folder itself. I can see the folder is a Read Only folder. I tested it in other manually created Read Only folder, also found it.
Finally I manually created the folder exactly like oFS.CreateFolder would do it, pasted manually a file into it and... it also found a file just fine.
As I witnessed, every test I conduct in a generated folder is failed, but done in a manually created one, pass.
Remarkable!
Had anyone such a case? Do you know why oFS.FileExists puts a blind eye on something created itself?
I'm using 64-bit Windows 10 Home, and I wrote both scrips in Visual Studio Code if that would be relevant.
Cheers guys, I can't be the first one.
EDIT for leeharvey1
Thank you leeharvey1 that you took a minute to have a look at this. This is the code that creates the directories:
Dim oFS, oFile, objShell, objFolder, sFolderPathspec, destination, file
Set oFS = CreateObject("Scripting.FileSystemObject")
sFolderPathspec = "C:\folder\where\files\are\"
Set objShell = CreateObject ("Shell.Application")
destination = "C:\folder\where\new\folders\with\files\are\intended\to\be\"
Set objFolder = objShell.Namespace(sFolderPathspec)
For Each file In objFolder.Items
name = file.Name
wykonano = objFolder.GetDetailsOf(file, 12)
If wykonano = "" Then
wykonano = objFolder.GetDetailsOf(file, 3)
End If
arr = Split(wykonano, " ")
brr = Split(arr(0), "-")
rok = brr(0)
miesiac = brr(1)
objFoldername = rok & "-" & miesiac
If CStr(oFS.FolderExists(destination & objFoldername)) >< "Prawda" Then
oFS.CreateFolder(destination & objFoldername)
End If
newdestination = destination & objFoldername & "\" & name
oFS.CopyFile sFolderPathspec & name, newdestination, False
Next
The whole testing for file existence started because I could not have the following to run:
oFS.CopyFile sFolderPathspec & name, newdestination, False
I would love it to copy but not overwrite. False, is however syntax correct, opposing to "Fałsz" (which would be correct in my Windows language). But the code crashes as soon as it hits the file that is already in the destination folder. Maybe should I have some kind of code which will let the sequence of code continue over the crashes caused by already existing files? (Like Python has)
So it took me to the following problem of testing for existence.
I figured I'll use the following method of the Files collection. As mentioned above, I get fails every time I conduct a test in generated folder, but done in a manually created one, pass.
That's the code (so far in a different VBScript file):
filestr = "C:\where\file\is\file.file"
Dim oFS
Set oFS = CreateObject("Scripting.FileSystemObject")
If oFS.FileExists(filestr) Then
MsgBox("Jest plik")
Else
MsgBox("Nie ma pliku")
End If
Function FileExists(FilePath)
Set oFS = CreateObject("Scripting.FileSystemObject")
If oFS.FileExists(FilePath) Then
FileExists=CBool(1)
Else
FileExists=CBool(0)
End If
End Function
If FileExists(filestr) Then
WScript.Echo "Does Exist"
Else
WScript.Echo "Does not exist"
End If
If (oFS.FileExists(filestr)) Then
WScript.Echo("File exists!")
WScript.Quit()
Else
WScript.Echo("File does not exist!")
End If
So, there are some details you wanted to know:
No, I am not working against a network shared file. It's all locally on my PC's ssd.
Have you tried disabling your anti-virus? No, if I'll need to do so in order to use it, I don't need the code.
I think I need to look for a file not for a folder, there is some kind of problem to locate the file. Do you think there could be also a problem to locate the folder itself?
Check folder Owner. Well, as far as I can see in Windows folder properties, it looks and have just the same settings as any other folder over there.
Thanks again leeharvey1 for your time!

Delete If Present at Destination, Copy To Destination If Error Move to Next

I have VBScript that I wrote a long while back to identify PDF based on the file name. It then appended data to the file name and moved it to the proper directory. I did it as a Select Case in order for it to loop for many file names. I am now attempting to modify the script to check if the file with the new name is already at the destination directory, and if so, delete the old file, and copy the new one (also if the file is open and can't be overwritten, ignore and move to the next). I've been searching on many forums, and have been able to find pieces of what I am attempting, but have been unable to successfully integrate the processes into my script. Here is what I have for my select case, this section is what gets repeated with the "VariableAddedtoFileName" changed.
Select Case Pname
Case "FileName"
sDestinationFolder = "\\Server\FileDir\"
sDestinationName = "VariableAddedtoFileName"
Set oFSO = CreateObject("Scripting.FileSystemObject")
sSourceFile = objStartFolder & "\" & objFile.Name
sDestinationFile = sDestinationFolder & "\" & Pname & " " & _
sDestinationName & Right(objFile.Name, 4)
If oFSO.FileExists(sDestinationFile) Then
Set oFSO = Nothing
Else
oFSO.MoveFile sSourceFile, sDestinationFile
Set oFSO = Nothing
End If
Case "StatementScriptTest"
Case Else
End Select
So if I change theSet oFSO line in the If oFSO.FileExists group to oFSO.DeleteFile sDestinationFile It deletes the file, but won't copy the new one. If Rerun, it then copies the file, since it is no longer there. I have tried multiple combinations of attempting to manipulate the if statements and then with no luck. I also attempted to delete the file prior to the if section with no avail. Any assistance would be greatly appreciated.
If the full script is needed I can provide, I only listed this section as it is the part that gets rerun numerous times. Also I am aware that there are multiple posts similar to this, but I want to figure out how to update my code to work.
Update: I have fixed the overwriting by using CopyFile:
If oFSO.FileExists(sDestinationFile) Then
oFSO.CopyFile sSourceFile, sDestinationFile, True
Else
oFSO.CopyFile sSourceFile, sDestinationFile, True
Set oFSO = Nothing
End If
But I am still getting errors if the file is open when the attempt to overwrite is made.
First, you won't need the IF statement if you will have the same code in each branch. Just use the oFSO.CopyFile sSourceFile, sDestinationFile, True and it will do the work for you.
Second, in order to catch the error, you will have to use On Error Resume Next declaration before the copy command and check if some error triggered:
On Error Resume Next ' this tells VB to not throw errors and to populate the Err object when an error occurs
oFSO.CopyFile sSourceFile, sDestinationFile, True
IF Err.Number <> 0 Then
' do something when error occurs
' ...
Err.Clear ' clears the error so it will not trigger this on the loop if no more errors occur
End IF
' When you want to stop ignoring the errors
On Error GoTo 0

Move files older than x minutes

I want the script to move all files (all file extensions *.*) older than 5 minutes from an INN folder to and ERROR folder. In my example C:\CopyFlow\Directory test\Inn\ to C:\CopyFlow\Directory test\Inn\Error
So I figured how to move files and how to find files older than x-time after looking it up. Howover, putting this together is the issue for me. Does anyone know how I can nail this?
This is what I got so far...
Dim age_threshold
age_threshold = 5
Dim folder_path
folder_path = WScript.Arguments(0)
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.getFolder(folder_path)
Dim old_file_not_found
old_file_found = 0
For Each file in f.Files
Dim age
age = DateDiff("n", file.DateLastModified, Now)
If age > age_threshold Then
old_file_found = 1
.MoveFile "C:\CopyFlow\Directory test\Inn\*.*", "C:\CopyFlow\Directory test\Inn\Error"
Exit for
end if
Next
WScript.Quit
I'm used to batch, so this is a little bit greek to me (source http://www.evalesco.com/check-any-file-older-x-minutes-directory).
Now where do I set (dim?) my INN and ERROR folder in this script? And I'm pretty sure the if age followed by .movefile is wrong, so I probably need a little correction there.
Update Whats missing in the image is a backslash after error (\error\) in the move.file line.
You can't call methods without an object providing the method, so .MoveFile should be fso.MoveFile. However, in its current form the script would move all files from C:\CopyFlow\Directory test\Inn if any of the files in the folder passed as argument to the script is older than 5 minutes.
What you need to do is pass C:\test\inn as the argument to the script, and move only those files that actually are older:
If age > age_threshold Then
file.Move "C:\test\inn\error\"
End If

Can I list apps that don't have registry entries?

I've been working on a way to quickly and easily list all of the software installed on my machine. Once complete, I'd like to send it out to my group so that I can have everyone run it. Since the purpose of this exercise is generate a list of all of the applications that we absolutely require access to to our IT administrators, I don't want to miss anything important.
Up to this point, I've used code very similar to this - it looks in the registry at SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\ and Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\ and gives me all of the software that has been installed. However, a bunch of important programs are conspicuously absent (e.g. R, RStudio, SQL Developer), and I assume it's because they do not use Windows Installers.
This brings me to my question - is there a way I can list all of the programs that can be run on my machine (that have not impacted the registry)? Essentially, I think I want all of the non-system *.exe files, but that is probably oversimplifying things.
Anyone have any ideas? My code is VBS now, but I can muddle my way through most things.
If you want to find them all then you need to search every single file on your machine and check whether or not it has an executable extension. I'm reasonably confident that you are not going to want to do this.
I read your answer and laughed, since I was also "reasonably confident" that I did not want to go through all of the files on my (or anyone else's) machine. Once the laughing stopped, I realized that that's essentially what I had to do...
I've come up with something that works, and it now takes minutes to run (it took seconds to only check the registry), but it does work. I'm putting it here in case it can assist someone else, or maybe someone can find a way to make it more efficient. You need to supply some paths to folders where you want to look for exe files, and a file that you want to output to.
Thanks for reading.
On Error Resume Next
Folders = Array("C:\users\me","C:\SoftwareFolder1","C:\SoftwareFolder2","C:\SoftwareFolder3")
sFile="C:\myExeFiles.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1
Const ForWriting = 2
Const OverwriteIfExist = -1
Set fFile = objFSO.CreateTextFile(sFile, OverwriteIfExist, OpenAsASCII)
For Each x In Folders
Set objFolder = objFSO.GetFolder(x)
suckTheData objFSO, fFile, objFolder
Set objFolder = Nothing
Next
MsgBox("Done")
Set objFSO = Nothing
Sub suckTheData(objFSO, fFile, objFolder)
' *** STEP 1 *** 'Find files with a partiular extension in this folder
For Each objFile In objFolder.Files
If UCase(objFSO.GetExtensionName(objFile.Name))="EXE" Then
fFile.Write objFile & vbCrLf
If Err.Number <> 0 Then
fFile.Write "Error: " & objFile & " " & Err.Number & Err.Source & " " & Err.Description & vbCrLf
End If
End If
Next
Set objFile = Nothing
' *** STEP 2 *** 'Now that we've processed files, repeat for subdirectories
For Each subf In objFolder.SubFolders
'some folders can't/shouldn't be checked -
'16 is a normal folder, 32 is an archive, 1046 is symbolic, etc
If subf.Attributes ="16" Then
suckTheData objFSO, fFile, subf
End If
Next
Set subf = Nothing
End Sub

Resources