Is there an way to dynamically change a new folder name if a folder with the same name already exists? For example, if I were to create a new file using fso.CreateFolder, would there be any way for the script to check for the folder and add an extra character, e.g from ("example") to ("example a"). I realize that I could use a file name from a variable and add characters like so:
dim filename
filename = ("example")
folderexists = fso.FolderExists(filename)
if (folderexists) then
fso.CreateFolder(filename + "a")
else
fso.CreateFolder(filename)
endif
but this would only work once, and after that would just continue to create and overwrite (filename + "a"). I would like the script to be able to detect, so for example:
first folder = (filename)
second folder = (filename + "a")
Third folder = (filename + "aa")
fourth folder = (filename + "aaa")
and so forth.
Something like this should do what you want:
i = 0
If fso.FolderExists(filename) Then
Do
i = i + 1
newname = filename & String(i, "a")
Loop While fso.FolderExists(newname)
filename = newname
End If
fso.CreateFolder(filename)
Personally I'd prefer a number suffix over a string of increasing length, though:
i = -1
If fso.FolderExists(filename) Then
Do
i = i + 1
newname = filename & Right("000" & i, 3)
Loop While fso.FolderExists(newname)
filename = newname
End If
fso.CreateFolder(filename)
Or you could append a timestamp as #Noodles suggested in the comments to the question:
Function LPad(n) : LPad = Right("00" & n, 2) : End Function
timestamp = Year(Now) & LPad(Month(Now)) & LPad(Day(Now)) & LPad(Hour(Now)) & _
LPad(Minute(Now)) & LPad(Second(Now))
fso.CreateFolder(filename & timestamp)
If you're just looking to create a temporary folder name, I usually do something like this:
Do
strFolder = "c:\" & Left(fso.GetTempName(), 8)
Loop While fso.FolderExists(strFolder)
How does it work?
GetTempName() returns an 8.3 filename in the following format:
radXXXXX.tmp
where each X represents a random hexadecimal digit. So you can just extract the first 8 chars to use for your folder name (or you can use the full name -- there's nothing stopping a folder from having an "extension"). Then just loop until you generate one that doesn't already exist.
Related
In one folder I have 10000 files and the the names of files is structured like this:
File1_0, File1_1, File1_2, File1_3
File2_0, File2_1, File2_2
File3_0, File3_1, File3_2, File3_3
...
File1000_0, File1000_1
I like to delete previous revisions of the files and to stay with the last one. Above files to become like this:
File1_3
File2_2
File3_3
....
File1000_1
I am trying the following: Put the name without _xx in an array then to remove the duplicates. But I don't think this is correct and for the moment I am stuck in the logic of the way I should do this.
This is the code:
Option Explicit
Dim fso, folder, sourcefolder, file
Dim b : b = Array()
Dim i
Dim x
Dim z
Dim y
sourcefolder = "C:\test"
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(sourcefolder)
i = 0
For Each file In folder.Files
i = i + 1
x = fso.GetBaseName(file)
ReDim Preserve b(UBound(b) + 1) : b(UBound(b)) = Left(x, Len(x)-2)
y = y & b(i-1) & "#"
Next
z = RemoveDuplicates(y)
For i=0 To UBound(z)-1
WScript.Echo i+1 & " " & z(i)
Next
Function RemoveDuplicates(str)
Dim d
Dim elem
If Trim(str) = "" Then
RemoveDuplicates = Array()
Exit Function
End If
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'make dictionary case-insensitive
For Each elem In Split(str, "#")
d(elem) = True
Next
RemoveDuplicates = d.Keys
End Function
One way to approach your problem is to build a dictionary that maps the basenames of the files to the highest revision number:
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
For Each f In fso.GetFolder(sourcefolder)
basename = fso.GetBaseName(f.Name)
a = Split(basename, "_")
revision = Int(a(UBound(a)))
prefix = a(0)
if d(prefix) < revision Then
d(prefix) = revision
End If
Next
Then run a second loop to remove all files whose basename doesn't have that revision:
For Each f In fso.GetFolder(sourcefolder)
basename = fso.GetBaseName(f.Name)
a = Split(basename, "_")
revision = Int(a(UBound(a)))
prefix = a(0)
If d.Exists(prefix) And revision < d(prefix) Then
f.Delete
End If
Next
Note that this code assumes that the underscore separating prefix and revision is the only one in the basename. If you have filenames containing more than one underscore (like foo_bar_1.txt) you'll need to adjust the extraction of prefix and revision to take care of that.
With that said, I strongly recommend against doing revision management in filenames. Use a revision control system (Git, Mercurial, Subversion, ...). That's what they were invented for.
Option Explicit
' Folder to process
Dim sourceFolder
sourceFolder = "."
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
' Regular expresion used to separate base name and sequence
Dim re
Set re = New RegExp
re.Pattern = "^(.*)_([0-9]+)$"
' Dictionary to store data for each sequence
Dim fileSequences
Set fileSequences = WScript.CreateObject("Scripting.Dictionary")
' fileSequences will use the base name of the files as key and
' hold as data an array with the higher sequence number and the
' associated file full path.
Dim f, colMatches, baseName, sequence
For Each f In fso.GetFolder(sourceFolder).Files
' Try to separate base name and sequence
Set colMatches = re.Execute( fso.GetBaseName(f.Name) )
' Only handle serialized files, those whose name match the regular expresion
If colMatches.Count > 0 Then
' base name and sequence are stored in the Submatches collection
' file extension is included in the base name to avoid handling separate series as one
baseName = LCase( colMatches.Item(0).SubMatches(0) & "." & fso.GetExtensionName( f.Name ) )
' Get the numeric sequence value - This should also handle zero prefixed sequence numbers
sequence = CLng( colMatches.Item(0).SubMatches(1) )
Select Case True
Case Not fileSequences.Exists( baseName )
' New sequence found - store current sequence value and the associated file path
fileSequences.Add baseName, Array( sequence, f.Path )
Case sequence < fileSequences.Item( baseName )(0)
' File with a lower sequence number found - Remove
f.Delete
Case sequence > fileSequences.Item( baseName )(0)
' File with a higher sequence number found - Remove previous one
fso.DeleteFile fileSequences.Item( baseName )(1)
' Update sequence information with new higher value and the associated file path
fileSequences.Item(baseName) = Array( sequence, f.Path )
End Select
End If
Next
I have a folder with 8 Excel files with the following naming convention:
date_All_Groups
date_HRFull_Status_All
date_RME_Groups_Excluded
These files are used for monthly reports, therefore the date will obviously always be different.
I will be using a macro to manipulate the data in each worksheet, however I cannot create the macro due the changing file name (the date) - the only guarantee I have is that each of these files will DEFINITELY contain a partial string match.
I have a script that finds the files in the location and will rename the file, but it only renames 1 file and its not the first file in the folder.
My issue is using the For Each loop effectively.
Here's the code I have:
Dim fso, folder, file
Dim folderName, searchFileName, renameFile1, renameFile2, renameFile3, renameFile4, renameFile5, renameFile6, renameFile7, renameFile8
'Path
folderName = "C:\test\"
'Future FileName
renameFile1 = "All Groups.csv"
renameFile2 = "Groups Excluded.csv"
renameFile3 = "No Exclusions.csv"
renameFile4 = "HR.csv"
renameFile5 = "AD Users.csv"
renameFile6 = "Encryption Status.csv"
renameFile7 = "ePO4 Not Encrypted.csv"
renameFile8 = "ePO5 Not Encrypted.csv"
' Create filesystem object and the folder object
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderName)
' Loop over all files in the folder until the searchFileName is found
For Each file In folder.Files
' See If the file starts with the name we search
If InStr(file.Name, "All_Groups") then
file.Name = renameFile1
End If
If InStr(file.Name, "Groups_Excluded") Then
file.Name = renameFile2
End If
If InStr(file.Name, "No_Exclusions") Then
file.Name = renameFile3
End If
If InStr(file.Name, "HR") Then
file.Name = renameFile4
End If
If InStr(file.Name, "AD_Users") then
file.Name = renameFile5
End If
If InStr(file.Name, "Encryption_Status") then
file.Name = renameFile6
End If
If InStr(file.Name, "ePO4") then
file.Name = renameFile7
End If
If InStr(file.Name, "ePO5") then
file.Name = renameFile8
End If
Exit For
' echo the job is completed
WScript.Echo "Completed!"
Next
The original code I found was exactly as above, but with only one If statement inside the For Each loop and the Exit For was inside the If statement.
Currently when I execute the script, the code renames only one file and its always the HR file first.
If I execute the script again, it then starts with All Groups, then Groups Excluded, and so on.
And the "Echo Completed" does not do anything either.
If you just want to rename your files to "canonical" names you could do something like this, assuming that you just want the date from the beginning of the filename removed and the underscores replaced with spaces:
Set re = New RegExp
re.Pattern = "\d{4}-\d{2}-\d{2}_(.*\.csv)"
For Each f In folder.Files
For Each m In re.Execute(f.Name)
f.Name = Replace(m.Submatches(0), "_", " ")
Next
Next
If the files have the same "date" you only need Find for that, for excample (if the date is a iso date "YYYYMMDD") (Date Returns "today" date)
IsoDate=CStr(Year(Date)) & Right("0" & CStr(Month(Date)),2) & Right("0" & CStr(Day(Date)),2)
And the for each:
For Each file In folder.Files
If InStr(file.Name, IsoDate) = 1 then 'if is in the start of the string
file.Name = Mid(file.Name, Len(IsoDate)+1) 'The same name with out date
End IF
Next
I use the below script to move all the specific files to destination folder. I want to copy the files to destination folder without duplicating.
As I am going to schedule to run the VBS for every 10 minutes, it should not again copy the same files which are already present in the folder.
Set fso = CreateObject("Scripting.FileSystemObject")
testfolder = "D:\env"
'fso.CreateFolder(testfolder)
MoveFiles fso.GetFolder("D:\Movie Keys\License\2013_Apr_19")
Sub MoveFiles(fldr)
For Each f In fldr.Files
basename = fso.GetBaseName(f)
extension = fso.GetExtensionName(f)
If LCase(extension) = "env" Then
dest = fso.BuildPath(testfolder, f.Name)
count = 0
Do While fso.FileExists(dest)
count = count + 1
dest = fso.BuildPath(testfolder, basename & "_" & count & "." _
& extension)
Loop
f.Move dest
End If
Next
For Each sf In fldr.SubFolders
MoveFiles sf
Next
End Sub
The problem here is that you want to copy all source files (including those in sub folders) into 1 destination folder. At this point there are chances that files will have the same file name and you may have files overwritten during the copy or files will be skipped as it will see it as a duplicate.
You're trying to achieve this with the following code
count = 0
Do While fso.FileExists(dest)
count = count + 1
dest = fso.BuildPath(testfolder, basename & "_" & count & "." & extension)
Loop
The problem is, you'll not know which file corresponds to which source file.
I suggest you rename the file as the full path. So, let's assume your source folder looks like:
In both the FolderExample and sub01 there is a file called image01.jpg.
I've used the underscore here to separate each folder (which may or may not be realistic for you). But by creating this new file name it means you cannot overwrite any other file with the same name!
Now, if you need to use the file again, the problem is the file name has changed. The good thing about using the underscore here is you can program another application to copy the file, split by underscore and then create the full path, get the file name and copy files accordingly.
This means, you can replace
If LCase(extension) = "env" Then
dest = fso.BuildPath(testfolder, f.Name)
count = 0
Do While fso.FileExists(dest)
count = count + 1
dest = fso.BuildPath(testfolder, basename & "_" & count & "." _
& extension)
Loop
f.Move dest
End If
with
If LCase(extension) = "env" Then
dest = fso.BuildPath(testfolder, f.Name)
if not (fso.FileExists(dest)) then
f.Move dest
end if
End If
If you want to synchronize folders without creating duplicates and without copying files that already exist in the destination, simply use robocopy:
robocopy "D:\Movie Keys\License\2013_Apr_19" "D:\env" *.env
Or in a batch script:
#echo off
set dst=D:\env
set src=D:\Movie Keys\License\2013_Apr_19
robocopy "%src%" "%dst%" *.env
Edit: Since you want to mangle the source tree into the destination folder, robocopy won't work in your case. Your existing code is close to what you want, but since you don't want to overwrite existing files and also don't want to create "versioned" copies you need to change this:
count = 0
Do While fso.FileExists(dest)
count = count + 1
dest = fso.BuildPath(testfolder, basename & "_" & count & "." _
& extension)
Loop
f.Move dest
into this:
If Not fso.FileExists(dest) Then f.Move dest
For using various destination folders depending on the extension you could use a dictonary to store the destination paths:
Set testfolder = CreateObject("Scripting.Dictionary")
testfolder.CompareMode = vbTextCompare 'case-insensitive
testfolder.Add "env", "D:\env"
testfolder.Add "key", "D:\key"
and change your code like this:
If testfolder.Exists(extension) Then
dest = fso.BuildPath(testfolder(extension), f.Name)
If Not fso.FileExists(dest) Then f.Move dest
End If
just looking for some help on this. I've tried a few different things and I'm stumped. I'm trying to take a check if a file exists in a directory, and if it does, then I want to rename add - Copy to the file name. Then it should check again if there is a conflict, and if there isn't it should move the file. Sounds simple enough, but it isn't working at all. Since I can't convert from String to DirectoryInfo, I have to declare multiple variables, and it just doesn't feel right. What can I do to fix this?
Dim fileExt As String = ""
Dim oldFileName As String = file.FullName
Dim newFileName As String = oldFileName
Dim newFileLocation = Environment.GetSpecialFolder(Environment.SpecialFolder.MyPictures) + "\" + file.Name
While FileIO.FileSystem.FileExists(newFileLocation) 'While File exists in new directory
'Add copy to filename
fileExt = fileType.Replace("*", "")
newFileName = newFileName.Remove(newFileName.LastIndexOf("."), (newFileName.Length - newFileName.LastIndexOf(".")))
newFileName += " - Copy"
newFileName += fileExt
'Rename file
FileSystem.Rename(oldFileName, newFileName)
'Declare a new DirInf variable because I can't use a string to set one
Dim newFile As New DirectoryInfo(newFileName)
'Move the new file to
newFile.MoveTo("C:\Users\" + Environ("USERNAME") + "\Pictures\")
ProgressBar.Value += 1
End While
You're looking for File.Move(), which takes two strings.
Also, "C:\Users\" + Environ("USERNAME") + "\Pictures\" is very wrong; many users do not have C: drives.
You should call Environment.GetSpecialFolder(Environment.SpecialFolder.MyPictures)
I have a vbscript that is used to rename files. What I need to implement into the script is something that deletes the "new file" if it already exists.
For example: I have a batch of files that are named like this 11111111.dddddddd.pdf where the files get renamed to 11111111.pdf. The problem is that when I rename to the 11111111.pdf format I end of with files that are duplicated and then makes the script fail because you obviously cant have 2 files with the same name. I need it to rename the first one but then delete the others that are renamed the same.
Here is what I have so far for my IF statement but it doesnt work and I get and error that says "Type mismatch: 'FileExists". I am not sure how to get this part of the code to execute the way I would like. Any help or suggestions would be greatly appreciated.
dim infolder: set infolder = fso.GetFolder(IN_PATH)
dim file
for each file in infolder.files
dim name: name = file.name
dim parts: parts = split(name, ".")
dim acct_, date_
acct_ = parts(0)
date_ = parts(1)
' file format of a.c.pdf
if UBound(parts) = 2 then
' rebuild the name with the 0th and 2nd elements
dim newname: newname = acct_ & "." & parts(2)
' use the move() method to effect the rename
file.move fso.buildpath(OUT_PATH, newname)
if newname = FileExists(file.name) Then
newname.DeleteFile()
end if
end if
next 'file
You're close, you just need to delete the file before trying to over-write it.
dim infolder: set infolder = fso.GetFolder(IN_PATH)
dim file: for each file in infolder.Files
dim name: name = file.name
dim parts: parts = split(name, ".")
if UBound(parts) = 2 then
' file name like a.c.pdf
dim newname: newname = parts(0) & "." & parts(2)
dim newpath: newpath = fso.BuildPath(OUT_PATH, newname)
' warning:
' if we have source files C:\IN_PATH\ABC.01.PDF, C:\IN_PATH\ABC.02.PDF, ...
' only one of them will be saved as D:\OUT_PATH\ABC.PDF
if fso.FileExists(newpath) then
fso.DeleteFile newpath
end if
file.Move newpath
end if
next
fileExists() is a method of FileSystemObject, not a global scope function.
You also have an issue with the delete, DeleteFile() is also a method of FileSystemObject.
Furthermore, it seems you are moving the file and then attempting to deal with the overwrite issue, which is out of order. First you must detect the name collision, so you can choose the rename the file or delete the collision first. I am assuming for some reason you want to keep deleting the new files until you get to the last one, which seemed implied in your question.
So you could use the block:
if NOT fso.FileExists(newname) Then
file.move fso.buildpath(OUT_PATH, newname)
else
fso.DeleteFile newname
file.move fso.buildpath(OUT_PATH, newname)
end if
Also be careful that your string comparison with the = sign is case sensitive. Use strCmp with vbText compare option for case insensitive string comparison.
IF both POS_History_bim_data_*.zip and POS_History_bim_data_*.zip.trg exists in Y:\ExternalData\RSIDest\ Folder then Delete File Y:\ExternalData\RSIDest\Target_slpos_unzip_done.dat