VBS - Script to Create Folder With Date/Time in Home Area

[Miscbrah]

Hi guys. Been staring at this all morning but not sure why it's not working.

 

It'll go on to become an all-powerful profile cleanup script, but I can't even get it to make the folder at the moment. Here is the phail so far:

 

'Declare the variables:
Dim dtmValue, strDate, strTime
Dim objFSO

'Create the file system object for creating folders:
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get current time in to a variable:
dtmValue = Now()

'set variable for that folder name:
strDate = "W:\profile_cleanup" & Month(dtmValue) & "_" & Day(dtmValue) & "_" & Year(dtmValue) & " " & Hour(dtmValue) & ":" & Minute(dtmValue) & ":" & Second(dtmValue)

'tell people what the score is:
Wscript.Echo "Hi - your profile data has been removed from your profile to your W: drive. It is now in a folder I've made called " & strDate


'Create the folders using objFSO
objFSO.CreateFolder(strDate)

 

It's just NOT creating that folder!!! Aaagghhh!!!

 

Anyone have any ideas?

[LosOjos]

You can't have colons in a folder name

 

I wrote this little function a while ago for VB(S), it'll take a given string and make it valid for file naming purposes:

 

Function strClean (strToClean, strSubstitute)
Dim objRegExp, outputStr
Set objRegExp = New Regexp

objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "[(?*"",\\<>~%{}+_.@:\/!;]+"
outputStr = objRegExp.Replace(strToClean, strSubstitute)

objRegExp.Pattern = "\-+"
outputStr = objRegExp.Replace(outputStr, "-")

strClean = outputStr
End Function

 

Should be self explanatory, you pass it a string "strToClean" and a substitute string "strSubstitute" to replace any invalid characters. You do of course have to be careful that your substitute string is valid

[Miscbrah]

You can't have colons in a folder name

 

http://media.tumblr.com/tumblr_lvca1nmCEE1r3tnkq.gif

 

Thanks! And that script will be useful Mr LosOjos.

[Miscbrah]

Okay I got more jip from it. Here it is so far:

 

'Declare the variables:
Dim dtmValue, strDate, strTime
Dim objFSO

'Create the file system object for creating folders:
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get current time in to a variable:
dtmValue = Now()

'set variable for that folder name:
strDate = "W:\profile_cleanup " & Month(dtmValue) & "_" & Day(dtmValue) & "_" & Year(dtmValue) & " " & Hour(dtmValue) & "-" & Minute(dtmValue) & "-" & Second(dtmValue)


'tell people what the score is:
Wscript.Echo "Hi - your profile data has been removed from your profile to your W: drive. It is now in a folder I've made called " & strDate & ", which is today's date and the current time."


'Create the folders using objFSO
objFSO.CreateFolder(strDate)

''''Everything ABOVE here works. Now to move the files...

sSource = "C:\Users\" & createobject("wscript.shell").expandenvironmentstrings("%username%") & "\Downloads"
sDestination = (strDate)

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set fld = objFSO.getfolder(sSource)

For Each f In fld.files
If objFSO.FileExists(sDestination & f.Name) Then
objFSO.MoveFile f.Path, sDestination & Left(f.Name, InStrRev(f.Name, ".") - 1) & "_1" & Mid(f.Name, InStrRev(f.Name, "."))

Else
objFSO.MoveFile f.Path, sDestination & f.Name
End If

Next

 

Now THAT is removing FILES but not FOLDERS from the source folder, but nothing materialises in the destination folder, though it creates that fine.

 

Anyone see what I'm getting at or where it's going wrong? I've exhausted Google for what I can understand.

 

Thanks for any help.

[LosOjos]

Off the top of my head, it could be that this part is missing a backslash between sDestination and f.name. Also, f.Path returns only the path to the file, not including the filename itself. The FSO file object has it's own Move method though which would be easier here:

 

For Each f In fld.files
If objFSO.FileExists(sDestination & f.Name) Then
objFSO.MoveFile f.Path, sDestination & Left(f.Name, InStrRev(f.Name, ".") - 1) & "_1" & Mid(f.Name, InStrRev(f.Name, "."))

Else
objFSO.MoveFile f.Path, sDestination & f.Name
End If

Change to:
For Each f In fld.files
If objFSO.FileExists(sDestination & "\" & f.Name) Then
f.Move sDestination & "\" & Left(f.Name, InStrRev(f.Name, ".") - 1) & "_1" & Mid(f.Name, InStrRev(f.Name, "."))

Else
f.Move sDestination & "\" &f.Name
End If

 

PS - I haven't tested that code and I'm working from memory so try it on a folder you don't mind losing the files from first!

 

PPS - for future reference, to get the complete file path (filename included), you can pass the file object itself as though it were a string, i.e. filePath = f

 

EDIT: Just tested, I was wrong: f.Path and just f return the same result, i.e. the full path including filename. That being said, the above code should still work as you do need that backslash between the folder name and filename

Edited May 7, 2013 by LosOjos

[bytejunkie]

i dont see a line where you're actually removing a folder. movefile wont remove folders, it will only remove the files. then you'll need to do a folder check for empty, something like

 

count = fld.files then

if count = 0

fld.delete

 

if its not empty, then you're going to have to go all recursive and thats never fun. actually, this is the crux of the matter at hand, you're going to have to go recursive to move this.

thats not valid vbs btw, ive not been in vbs for a looong time, been using python.

 

at this point, i'd do one of two things. find somebody elses example of recursive file deletion/move to crib how its done. or i'd break out a copy of rsync and trigger an rsync job to do the move, which comes with the added benefit of logging verbosely so you know its working or why its not working...

 

quick note as well. if you're going to be moving the user profile, im assuming a windows profile. i think there is a file something like ntdesktop.ini which will be a pain to move. also ntprofile.ini which i think holds the gp from last update. these live in the profile somewhere so watch out for them.

 

another thing while im on, strDate isn't a date, its a path. sometimes it makes other peoples code easier to read if it makes sense.

[Miscbrah]

Gosh that was quick Mr Ojos!

 

That seems to work fine for files now, but it's not copying any subfolders from the source folder to the destination folder. So close I can taste it though.

 

Thanks for the hand holding.

[Miscbrah]

i dont see a line where you're actually removing a folder. movefile wont remove folders, it will only remove the files. then you'll need to do a folder check for empty, something like

 

count = fld.files then

if count = 0

fld.delete

 

if its not empty, then you're going to have to go all recursive and thats never fun. actually, this is the crux of the matter at hand, you're going to have to go recursive to move this.

thats not valid vbs btw, ive not been in vbs for a looong time, been using python.

 

at this point, i'd do one of two things. find somebody elses example of recursive file deletion/move to crib how its done.

 

Heh, yeah have been. Not really up to much in vbs. :/ Some of the things you just said sound like Martian I'll be honest. :/

 

quick note as well. if you're going to be moving the user profile, im assuming a windows profile. i think there is a file something like ntdesktop.ini which will be a pain to move. also ntprofile.ini which i think holds the gp from last update. these live in the profile somewhere so watch out for them.

 

Yeah, they're not mega essential so was planning on binning those in the script sometime if they got troublesome.

 

another thing while im on, strDate isn't a date, its a path. sometimes it makes other peoples code easier to read if it makes sense.

 

strDate is something I'd set earlier to a path in the home area, which is created by the first part of the script with the current date and time in the folder name. This sound right now?

[bytejunkie]

i might need to explain recursiveness then.

 

when you do this move, you need to write a script that goes.

 

1. move into folder.

2. enumerate folders

3. move into first folder

4. perform the action

5. repeat 3 and 4 for other folders

 

this action of stepping through a tree of folders in called recursiveness.

you are basically saying take me as deep as possible into the folder tree, perform the action, step back a level and do it again.

so you actually end up moving the deepest folder first, then step up a level, work on that folder (or folders), then step up a level etc etc...

 

found this

 

vbscript - Question about recursively moving file - Stack Overflow

 

look at the way the last line of the function calls itself. so it does its action, then calls itself for the subfolders. which is going to lead to performing the action at a lower level, then calling itself again. and again. until it runs out of subfolders.

 

 

hope that makes sense, cos im not the best at explaining stuff in wording.

[LosOjos]

OK I missed the part about needing to move folders too. Looking at your code, moving the folders themselves is unnecessary as you're creating new folders at sDestination anyway, though to retain the folder structure you'll need to add a little more detail to the path. Simplest way to do this (assuming your sSource is the top most level and it is only it's subfolders and files that are needed) would be to add another For...Next statement encapsulating your current routine that iterates all the subfolders. For example, this should (again, not tested!) move files using the same tree structure as the sSource folder:

 

'we run the original routine first to deal with the sSource folder
For Each f In fld.files
If objFSO.FileExists(sDestination & "\" & f.Name) Then
f.Move sDestination & "\" & Left(f.Name, InStrRev(f.Name, ".") - 1) & "_1" & Mid(f.Name, InStrRev(f.Name, "."))

Else
f.Move sDestination & "\" & f.Name
End If
Next

'now we iterate subfolders in fld folder object
For Each subF in fld.SubFolders

'iterate through files in current subfolder (notice we add subF.Name to the path to retain folder structure)
For Each f In subF.files
If objFSO.FileExists(sDestination & "\" & subF.Name & "\" & f.Name) Then
f.Move sDestination & "\" & subF.Name & "\" & Left(f.Name, InStrRev(f.Name, ".") - 1) & "_1" & Mid(f.Name, InStrRev(f.Name, "."))

Else
f.Move sDestination & "\" & subF.Name & "\" & f.Name
End If
Next

Next

 

Again, it comes with the "untested, try at your own risk!" disclaimer

 

The problem here is if the subfolder contains subfolders - that's where doing a count of the number of folders in each folder becomes necessary so you can repeat this recursion through every level.

 

At that point, putting your folder handling in to a sub routine would make your code much easier to follow

 

(Sorry for all the edits, trying to fit in explanation around work!)

 

Basically, your sub routine would perform the same actions as the nested For...Next loop above, but would check before it executed if the current sub folder contained any folders. If so, it would call itself, passing each sub folder in turn, until eventually it ran through every single folder. It's not as tricky as it sounds, but there is potential to lock your machine up if you're not careful with your loops!

Edited May 7, 2013 by LosOjos

[LosOjos]

OK, here goes (you know the disclaimer routine by now!). This code should work through all files and folders within the sSource folder and recreate them using your naming structure at sDestination:

 

'Declare the variables:
Dim dtmValue, strDate, strTime
Dim objFSO

'Create the file system object for creating folders:
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get current time in to a variable:
dtmValue = Now()

'set variable for that folder name:
strDate = "W:\profile_cleanup " & Month(dtmValue) & "_" & Day(dtmValue) & "_" & Year(dtmValue) & " " & Hour(dtmValue) & "-" & Minute(dtmValue) & "-" & Second(dtmValue)


'tell people what the score is:
Wscript.Echo "Hi - your profile data has been removed from your profile to your W: drive. It is now in a folder I've made called " & strDate & ", which is today's date and the current time."


'Create the folders using objFSO
objFSO.CreateFolder(strDate)

''''Everything ABOVE here works. Now to move the files...

sSource = "C:\Users\" & createobject("wscript.shell").expandenvironmentstrings("%username%") & "\Downloads"
sDestination = (strDate)

Set objFSO= nothing

Recursion sSource, sDestination

Sub Recursion(sSource, sDest)
Dim FSO				'File System Object
Dim oFol			'Folder object
Dim oSubFol			'Subfolder object
Dim oFil			'File object
Dim oFils			'Files

Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFol = FSO.GetFolder(sSource)

For Each oSubFol in oFol.SubFolders
Recursion oSubFol, sDest & "\" & oSubfol.Name
next

Set oFils = oFol.Files
For Each oFil in oFils  '-- enumerate files in the folder using For/Each. Each oFil is a File object.
       If FSO.FolderExists(sDest) = FALSE Then FSO.CreateFolder(sDest)
If FSO.FileExists(sDest & "\" & oFil.Name) Then
	oFil.Move sDest & "\" & Left(oFil.Name, InStrRev(oFil.Name, ".") - 1) & "_1" & Mid(oFil.Name, InStrRev(oFil.Name, "."))
Else
	oFil.Move sDest & "\" & oFil.Name
End If
Next 

Set oFils = Nothing
Set oFol = Nothing
Set oSubFol = nothing
Set oFil = nothing
End Sub

 

EDIT: forgot to rename a couple of variables!

 

EDIT2: added logic to create missing folders in Recursion's main For..Next loop

Edited May 7, 2013 by LosOjos

[Miscbrah]

Wow, when you help out LosOjos you really go above and beyond. Thanks so much!

 

It's doing stuff, but gives me an error on line 48 char 3 with file not found.

 

If this is turning into hassle don't worry, the incarnation of it that just moves files and doesn't do subfolders will probably be alright.

 

Cheers though loads and loads.

[LosOjos]

Wow, when you help out LosOjos you really go above and beyond. Thanks so much!

 

It's doing stuff, but gives me an error on line 48 char 3 with file not found.

 

If this is turning into hassle don't worry, the incarnation of it that just moves files and doesn't do subfolders will probably be alright.

 

Cheers though loads and loads.

 

I love solving problems, especially if there's the opportunity to do so with code lol, so it's not an entirely selfless act I must admit!

 

Could you try the code as it is right now please and let me know if it works - I had left in a couple of errors I've now edited out (I think) so just want to be sure you're trying the latest version of the code before I start to debug it

[LosOjos]

sorry, fail in my logic! Just spotted it

 

The reason you're getting an error is that the check for an existing folder comes too late in the recursion - you can't create a folder if it's parent folder doesn't exist! Easy fix, just make sure we create any missing folders before we get to their sub folders by moving the FolderExists line to an earlier point in the loop. Here's the final code for you (note I removed some now unnecessary code from the earlier part of your script too for cleanliness):

 

'Declare the variables:
Dim dtmValue, strDate, strTime

'Get current time in to a variable:
dtmValue = Now()

'set variable for that folder name:
strDate = "W:\profile_cleanup " & Month(dtmValue) & "_" & Day(dtmValue) & "_" & Year(dtmValue) & " " & Hour(dtmValue) & "-" & Minute(dtmValue) & "-" & Second(dtmValue)


'tell people what the score is:
Wscript.Echo "Hi - your profile data has been removed from your profile to your W: drive. It is now in a folder I've made called " & strDate & ", which is today's date and the current time."

''''Everything ABOVE here works. Now to move the files...

sSource = "C:\Users\" & createobject("wscript.shell").expandenvironmentstrings("%username%") & "\Downloads"
sDestination = (strDate)

Recursion sSource, sDestination

Sub Recursion(sSource, sDest)
Dim FSO				'File System Object
Dim oFol			'Folder object
Dim oSubFol			'Subfolder object
Dim oFil			'File object
Dim oFils			'Files

Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFol = FSO.GetFolder(sSource)

'create folder at destination if it's missing, otherwise we won't be able to create sub folders later
If FSO.FolderExists(sDest) = FALSE Then FSO.CreateFolder(sDest)

For Each oSubFol in oFol.SubFolders
Recursion oSubFol, sDest & "\" & oSubfol.Name
next

Set oFils = oFol.Files
For Each oFil in oFils  '-- enumerate files in the folder using For/Each. Each oFil is a File object.
If FSO.FileExists(sDest & "\" & oFil.Name) Then
	oFil.Move sDest & "\" & Left(oFil.Name, InStrRev(oFil.Name, ".") - 1) & "_1" & Mid(oFil.Name, InStrRev(oFil.Name, "."))
Else
	oFil.Move sDest & "\" & oFil.Name
End If
Next 

Set oFils = Nothing
Set oFol = Nothing
Set oSubFol = nothing
Set oFil = nothing
End Sub

[Miscbrah]

Well, whatever your motivation I couldn't even have come close to this so thanks.

 

Still getting an error off it, this time file not found on line 43 char 3.

[LosOjos]

Well, whatever your motivation I couldn't even have come close to this so thanks.

 

Still getting an error off it, this time file not found on line 43 char 3.

 

Odd, this is the first version I've actually tested as working! lol.

 

I'm a little stumped... you could add in a line just before the line causing an error that pops up a message box containing the intended destination and see if it brings anything to light...

 

One thing that comes to mind is that the script will only create the first folder from the intial sDestination, so if say sDestination was at X:\folder1\sDest and folder 1 didn't exist or X: wasn't a valid drive letter, then the code would fall over...

[Miscbrah]

I'll have a look, see what I can understand.

 

You're a wonderful man L.O. thanks loads!

[mac_shinobi]

@Mischbrah - any chance you can post back with a step by step of what you want the script to do

 

Did you want it to retain the same structure etc etc

 

Just wondering if you could possibly use xcopy or similar command line command by using %comspec% with the relevant switches etc in the script ?

 

Maybe easier then trying to enumerate / recurse through all directories / files etc etc

[Miscbrah]

Hi! Yes the script would ideally create a folder, named to include the current date and time (to the second) in a user's home area, and move into that everything from the user's documents, downloads and pictures and videos folder from their profile. Users could run it before submitting a case for the red X of death in the taskbar.

 

I would use folder redirection, but it plain isn't working here. Downloads I've redirected through GP with Chrome's policies.