This script collects all files in a folder and renames the files by appending the number of lines to the file name. All files are .txt files. The method (since fso.MoveFile and fso.DeleteFile are too particular, generating permissions errors) is to
create the text files,
then create a collection of the files in the folder,
then copy each file into the same folder with a new name, and
finally to delete the original file that was copied.
The script works ok, unless there are no empty text files in the collection. What happens is, the collection gets rebuilt with the new files and the script once again renames the files. I know I can prevent this by checking each file for the existence of certain repeating character strings, but I'd like to know what's happening? Why does the script rebuild the file collection and run through them again renaming each one? This continues on until I kill the process.
Another interesting factoid is, if I happen to trap an empty text file, my message is displayed and the script stops there, but has still reprocessed the first file in the collection a second time. Note that the empty file just happens to be the last one in the collection, but the first filed is once again processed.
So, by design a created text file named 'ab0.txt' gets renamed to 'ab0-15.txt' since it has 15 lines of text in it. What happens is this newly renamed file looks like 'ab0-15-15-15-15-15-15-15-15-15-15.txt'
Questions: What's going on? And is there a better and more efficient way to accomplish this objective?
Here's the code pertinent to the issue:
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(strSaveTo)
Set colFiles = oFolder.Files
' Call Sub to copy and rename
ChangeFileName colFiles
MsgBox("File renaming complete.")
' Exit code
Sub ChangeFileName(collectionSet)
Const ForReading = 1
Dim oFile
For Each oFile In collectionSet
Set LineCnt = fso.OpenTextFile(oFile, ForReading)
If oFile.Size = 0 then
'if this msg is not included, weird things happen
MsgBox("The file named " & oFile & _
" is empty.You may want to verify and manually delete it.")
'[I had some code in here to delete the empty file, but nothing worked]
Else
Do While LineCnt.AtEndOfStream <> True
LineCnt.SkipLine
Loop
lineVar = lineCnt.Line-1
strNewFile = strSaveTo & Left(oFile.name, Len(oFile.name)-4) & _
"-" & lineVar & ".txt"
fso.CopyFile oFile, strNewFile
LineCnt.Close
fso.DeleteFile oFile, True
End If
Next
End Sub
I've heard anecdotal evidence that the Files collection is "live", meaning that newly created files will be added to the collection and iterated over, but I can't find any documentation that says one way or the other. In any case, it's probably a good idea to copy the File objects in the collection to an array first before processing them:
Dim oFile
Dim fileArray()
Dim i
ReDim fileArray(collectionSet - 1)
i = 0
For Each oFile in collectionSet
Set fileArray(i) = oFile
i = i + 1
Next
For Each oFile In fileArray
' Count lines and rename
Next
It seems that collectionSet is the collection of files in the folder that you are trying to modify. The problem is that with each pass through the for-each loop you are adding files to this folder, some of which are fed back into the loop. What you need to do is the find a way to take a snapshot of the folder before you try to iterate over it. The way to do this would be to replace the folder collectionSet by a collection of strings which are the names of the files before you iterate over it, and modify your code to open the files by their name (instead of via a file object). That way the collection won't be expanding while you iterate over it.
You should create your vars in the scope they are used (e.g. your
file/folder objects are used in the sub.
Always explicit(ly) declare your vars.
You don't need to copy the file and rename it then do the delete.
Just rename it with the FileObject.Name property.
Here is an example:
Option Explicit 'always declare your vars!
Dim strFolder: strFolder = "c:\temp\Rename Test"
Dim strExtension: strExtension = "txt"
' Call Sub to rename the files in the folder
ChangeFileName strFolder, strExtension
Sub ChangeFileName(strFolder, strExtension)
Const ForReading = 1
Dim FSO: set FSO = CreateObject("Scripting.FileSystemObject")
Dim objFolder: set objFolder = FSO.GetFolder(strFolder)
Dim colFiles: set colFiles = objFolder.Files
Dim objFile
Dim intCount
Dim strFileName
Dim objTextStream
For Each objFile In colFiles
msgbox "File: " & objfile.path & vbcrlf & FSO.GetExtensionName(objFile.path)
if UCase(FSO.GetExtensionName(objFile.Path)) = UCase(strExtension) and _
objFile.Size > 0 then
'set LineCnt = FSO.OpenTextFile(objFile, ForReading)
set objTextStream = objFile.OpenAsTextStream(ForReading,-2)
intCount = 0
strFileName = objFile.Name
Do While objTextStream.AtEndOfStream <> True
intCount = intCount + 1
objTextStream.ReadLine
Loop
objTextStream.Close
objFile.Name = FSO.GetBaseName(objFile.Path) & "-" & _
intCount & "." & FSO.GetExtensionName(objFile.Path)
end if
Next
End Sub
Related
Update-----
My vbs script should take camera photos and rename them from a unique name like "0634_IMG" to a recursive number from 01 to 100. For example say there are 3 photos in the folder: 001_IMG, 003_IMG, and 006_IMG my script should rename these files to 01, 02, and 03 respectively.
I have a version that works when I drag and drop the script into the specific folder, but there are 1000's of folders so I want to be able to place it into the parent folder and it execute on all subfolders.
So it should be a folder drill down that only looks for files with the extension GIF, IMG, and PNG.
Folder Structure: Location>Block#>Letter(comprised of 3 folders A, B, and C)>Chamber(for each letter there are 4 subfolders)>Pictures (each subfolder has the pictures I am trying to rename)
so to review, I want to be able to put the script in the same folder as the block# and it execute on the pictures in the last folder for every subfolder. So after I run the script each picture should be renamed 01-100 and maintain its position within the folder scheme.
Thanks to the help of CHNguyen, my code was edited so that it would maintain the folder structure I describe above.
The issue now is that the script is numbering the pictures in every folder continuously and does not start or restart at 1.... For example after executing the script, Folder 1 (which contains 30 images) is outputting file names 830-860, when it should be 1-30. Additionally, the other subfolders have this same issue and it seems that the count or "intFileParts" is not being reset and I can't get it to reset.
I ask the coding gods for help as I am a newb and thanks in advance.
Option Explicit
Dim fso
Dim oFolder, oSubFolder
Dim oFile
Dim sPath, strOldName, strNewName
Dim intFileParts
' Create the instance of the fso.
Set fso = CreateObject("Scripting.FileSystemObject")
' Set the folder you want to search.
sPath = fso.GetFolder(fso.GetAbsolutePathName(".")) + "\"
RenameFiles(sPath)
Sub RenameFiles(Path)
Set oFolder = fso.GetFolder(Path)
intFileParts = 1 ' Restart at 1
' Loop through each file in the folder.
For Each oFile In oFolder.Files
' Only select images
Select Case oFile.Type
Case "GIF Image", "JPG Image", "PNG Image"
End Select
' Get complete file name with path.
strOldName = oFile.Path
' Build the new file name.
strNewName = ""
strNewName = fso.GetParentFolderName(oFile) & "\" & Right("000" & fso.GetBaseName(oFile), 3) & "." & fso.GetExtensionName(oFile)
' Use the MoveFile method to rename the file.
fso.MoveFile strOldName, strNewName
intFileParts = intFileParts + 1
Next
For Each oSubFolder In oFolder.Subfolders
RenameFiles(oSubFolder.Path)
Next
End Sub
Set oFile = Nothing
Set oSubFolder = Nothing
Set oFolder = Nothing
Set fso = Nothing
This should do:
I reworked the ' Build the new file name. section to properly get the file's parent folder using fso.GetParentFolderName() to "maintain its position within the folder scheme". The padding and incrementing of the numeric value in the filename was also improved/simplified using VB and fso methods.
The "missing" code under ' Use the MoveFile method to rename the file. was also added to perform the rename via fso.MoveFile()
Code:
Option Explicit
Dim fso
Dim oFolder, oSubFolder
Dim oFile
Dim sPath, strOldName, strNewName
Dim intFileParts
' Create the instance of the fso.
Set fso = CreateObject("Scripting.FileSystemObject")
' Set the folder you want to search.
sPath = fso.GetFolder(fso.GetAbsolutePathName(".")) + "\"
RenameFiles(sPath)
Sub RenameFiles(Path)
Set oFolder = fso.GetFolder(Path)
intFileParts = 1 ' Restart at 1
' Loop through each file in the folder.
For Each oFile In oFolder.Files
' Only select images
Select Case oFile.Type
Case "GIF Image", "JPG Image", "PNG Image"
End Select
' Get complete file name with path.
strOldName = oFile.Path
' Build the new file name.
strNewName = ""
strNewName = fso.GetParentFolderName(oFile) & "\" & Right("000" & intFileParts, 3) & "." & fso.GetExtensionName(oFile)
' Use the MoveFile method to rename the file.
fso.MoveFile(strOldName, strNewName)
intFileParts = intFileParts + 1
Next
For Each oSubFolder In oFolder.Subfolders
RenameFiles(oSubFolder.Path)
Next
End Sub
Set oFile = Nothing
Set oSubFolder = Nothing
Set oFolder = Nothing
Set fso = Nothing
I have some XML files in a folder \\demo.US\Modified\. The files in the folder are:
USA.xml
Canada.xml
Mexico.xml
The code below is changing the encoding from UTF-8 to windows-1252 and is creating a modified file mod.xml.
This mod.xml file have data from all three XML files concatenated.
I need help so I can save files separately.
If value of objFile.Name is USA.xml then it should save modified file name as USA_mod.xml. the output for \\demo.US\Modified\ folder after execution is complete should have mod files in it as below.
USA.xml
Canada.xml
Mexico.xml
USA_mod.xml
Canada_mod.xml
Mexico_mod.xml
The code I used is as follows.
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "\\demo.US\Modified\"
Set objFolder = objFSO.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
For Each objFile In colFiles
WScript.Echo objFile.Name
Set objFile = objFSO.OpenTextFile(objStartFolder & objFile.Name, 1)
Set outFile = objFSO.OpenTextFile(objStartFolder & "mod.xml", 2, True)
Do Until objFile.AtEndOfStream
strContent = strContent & objFile.ReadLine
Loop
MsgBox strContent
strContent = Replace(strContent, "encoding=""UTF-8""", "encoding=""windows-1252""")
outFile.WriteLine strContent
outFile.Close
objFile.Close
Next
As others have already pointed out, you shouldn't do what you're attempting to do here, because it is very likely to create more problems down the road. Find the cause of the issue and fix that instead of trying to handle symptoms. You have been warned.
With that said, the reason why the content of all input files is written to the same output file is because you always specify the same output file. That file should contain only the content of the last input file, though, because you open the file for writing (thus erasing previous content) rather than for appending.
Replace these lines:
Set objFile = objFSO.OpenTextFile(objStartFolder & objFile.Name, 1)
Set outFile = objFSO.OpenTextFile(objStartFolder & "mod.xml", 2, True)
with this:
Set inFile = objFile.OpenAsTextStream
outFilename = objFSO.BuildPath(objStartFolder, objFSO.GetBaseName(objFile) & "_mod.xml")
Set outFile = objFSO.OpenTextFile(outFilename, 2, True)
and also replace the other occurrences of objFile after that with inFile (always avoid changing the value of a loop variable), and the code should do what you expect it to do. But again, be warned that the output may not be valid XML.
I managed to made it working, below is the code I used
Dim objFSO, filePath, objFile, colFiles, s , FName
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set filePath = objFSO.GetFolder("\\demo.US\Modified\")
Set colFiles = filePath.Files
For Each FName in colFiles
set objFile = objFSO.OpenTextFile(FName.Path,1)
set outFile = objFSO.OpenTextFile(LEFT(FName.Path,instr(FName.Path,".xml")-1) &"_mod.xml",2,True)
do until objFile.AtEndOfStream
strContent=objFile.ReadLine
Loop
strContent = Replace(strContent, "encoding=""UTF-8""", "encoding=""windows-1252""")
outFile.WriteLine strContent
outFile.Close
objFile.Close
Next
I am using this code to zip all files in a folder into a newly created .zip file:
Dim FileNameZip, FolderName
Dim filename As String, DefPath As String
Dim oApp As Object
(defining all paths needed)
'Create empty Zip File
NewZip (FileNameZip)
Set oApp = CreateObject("Shell.Application")
'Copy the files to the compressed folder
oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).items.Count = oApp.Namespace(FolderName).items.Count
Application.Wait (Now + TimeValue("0:00:01"))
Loop
This works without problems as long as my target folder is different from the folder where my files are.
But I have a problem when I try to take all files from a folder, put them into .zip and have the archive generated in the same folder - it creates the archive and then tries to put it into itself, which of course fails.
I am looking for a way to zip all files from a folder except this one newly created.
I looked here: https://msdn.microsoft.com/en-us/library/office/ff869597.aspx but this looks very Outlook-specific and I have no idea how to apply this to a Windows folder.
Rather than add all files at once, which will include the zip file you create, loop through the files with the FileSystemObject and compare their names against the zip file name before adding to the zip:
Sub AddFilesToZip()
Dim fso As Object, zipFile As Object, objShell As Object
Dim fsoFolder As Object, fsoFile As Object
Dim timerStart As Single
Dim folderPath As String, zipName As String
folderPath = "C:\Users\darre\Desktop\New folder\" ' folder to zip
zipName = "myzipfile.zip" ' name of the zip file
Set fso = CreateObject("Scripting.FileSystemObject") ' create an fso to loop through the files
Set zipFile = fso.CreateTextFile(folderPath & zipName) ' create the zip file
zipFile.WriteLine Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
zipFile.Close
Set objShell = CreateObject("Shell.Application")
Set fsoFolder = fso.GetFolder(folderPath)
For Each fsoFile In fsoFolder.Files ' loop through the files...
Debug.Print fsoFile.name
If fsoFile.name <> zipName Then ' and check it's not the zip file before adding them
objShell.Namespace("" & folderPath & zipName).CopyHere fsoFile.Path
timerStart = Timer
Do While Timer < timerStart + 2
Application.StatusBar = "Zipping, please wait..."
DoEvents
Loop
End If
Next
' clean up
Application.StatusBar = ""
Set fsoFile = Nothing
Set fsoFolder = Nothing
Set objShell = Nothing
Set zipFile = Nothing
Set fso = Nothing
MsgBox "Zipped", vbInformation
End Sub
I would create the zip file in the temporary folder and finally move it to the destination folder. Two notes worth mentioning:
1- The approach of looping until the Item counts are the same in the folder and the zip file is risky, because if the zipping fails for an individual item, it results in an infinite loop. For this reason it's preferable to loop as long as the zip file is locked by the shell.
2- I will use early binding with the Shell because late-binding the Shell32.Application seems to have issues on some installations. Add a reference to Microsoft Shell Controls and Automation
Sub compressFolder(folderToCompress As String, targetZip As String)
If Len(Dir(targetZip)) > 0 Then Kill targetZip
' Create a temporary zip file in the temp folder
Dim tempZip As String: tempZip = Environ$("temp") & "\" & "tempzip1234.zip"
CreateObject("Scripting.FileSystemObject").CreateTextFile(tempZip, True).Write _
Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
' compress the folder into the temporary zip file
With New Shell ' For late binding: With CreateObject("Shell32.Application")
.Namespace(tempZip).CopyHere .Namespace(folderToCompress).Items
End With
' Move the temp zip to target. Loop until the move succeeds. It won't
' succeed until the zip completes because zip file is locked by the shell
On Error Resume Next
Do Until Len(Dir(targetZip)) > 0
Application.Wait Now + TimeSerial(0, 0, 1)
Name tempZip As targetZip
Loop
End Sub
Sub someTest()
compressFolder "C:\SO\SOZip", "C:\SO\SOZip\Test.zip"
End Sub
I found zipping via VBA to be hard to control without third party tools, the below may not be a direct answer but may aid as a solution. The below is an excerpt of the code I used to generate epubs which are not much more than zip files with a different extension. This zipping section never failed in hundreds of runs.
Public Function Zip_Create(ByVal StrFilePath As String) As Boolean
Dim FSO As New FileSystemObject
Dim LngCounter As Long
If Not FSO.FileExists(StrFilePath) Then
'This makes the zip file, note the FilePath also caused issues
'it should be a local file, suggest root of a drive and then use FSO
'to open it
LngCounter = FreeFile
Open StrFilePath For Output As #LngCounter
Print #LngCounter, "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
Close #LngCounter
End If
Zip_Create = True
End Function
Public Function Zip_Insert(ByVal StrZipFilePath As String, ByVal StrObject As String) As Boolean
Dim BlnYesNo As Boolean
Dim LngCounter As Long
Dim LngCounter2 As Long
Dim ObjApp As Object
Dim ObjFldrItm As Object
Dim ObjFldrItms As Object
Dim StrContainer As String
Dim StrContainer2 As String
If Procs.Global_IsAPC Then
'Create the zip if needed
If Not FSA.File_Exists(StrZipFilePath) Then
If Not Zip_Create(StrZipFilePath) Then
Exit Function
End If
End If
'Connect to the OS Shell
Set ObjApp = CreateObject("Shell.Application")
'Pause, if it has just been created the next piece of
'code may not see it yet
LngCounter2 = Round(Timer) + 1
Do Until CLng(Timer) > LngCounter2
DoEvents
Loop
'Divide the path and file
StrContainer = Right(StrObject, Len(StrObject) - InStrRev(StrObject, "\"))
StrObject = Left(StrObject, Len(StrObject) - Len(StrContainer))
'Connect to the file (via the path)
Set ObjFldrItm = ObjApp.NameSpace(CVar(StrObject)).Items.Item(CVar(StrContainer))
'Pauses needed to avoid all crashes
LngCounter2 = CLng(Timer) + 1
Do Until CLng(Timer) > LngCounter2
DoEvents
Loop
'If it is a folder then check there are items to copy (so as to not cause and error message
BlnYesNo = True
If ObjFldrItm.IsFolder Then
If ObjFldrItm.GetFolder.Items.Count = 0 Then BlnYesNo = False
End If
If BlnYesNo Then
'Take note of how many items are in the Zip file
'Place item into the Zip file
ObjApp.NameSpace(CVar(StrZipFilePath)).CopyHere ObjFldrItm
'Pause to stop crashes
LngCounter2 = CLng(Timer) + 1
Do Until CLng(Timer) > LngCounter2
DoEvents
Loop
'Be Happy
Zip_Insert = True
End If
Set ObjFldrItm = Nothing
Set ObjApp = Nothing
End If
End Function
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
Essentially, I want to get the names of all .zip files in a given directory and unzip them. Right now, I'm working on just getting the names of the files into some sort of array or list. It's grabbing the files correctly, but I don't know a whole lot about VBScript, could someone point me in the right direction?
Dim fileList
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "C:\Test"
Set objFolder = objFSO.GetFolder(objStartFolder)
Wscript.Echo objFolder.Path
Set colFiles = objFolder.Files
For Each objFile in colFiles
If UCase(objFSO.GetExtensionName(objFile.name)) = "ZIP" Then
Wscript.Echo objFile.Name
'Add file names to fileList variable
End If
Next
There is...
' using vbArray
ReDim fileArray(-1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "C:\Test"
Set objFolder = objFSO.GetFolder(objStartFolder)
For Each objFile In objFolder.Files
If UCase(objFSO.GetExtensionName(objFile.Name)) = "ZIP" Then
ReDim Preserve fileArray(UBound(fileArray) + 1)
fileArray(UBound(fileArray)) = objFile.Name
End If
Next
WScript.Echo Join(fileArray, vbNewLine)
' using .NET ArrayList (as no biult-in Lists in VBScript)
Dim fileList
Set fileList = CreateObject("System.Collections.ArrayList")
For Each objFile In objFolder.Files
If UCase(objFSO.GetExtensionName(objFile.Name)) = "ZIP" Then
fileList.Add objFile.Name
End If
Next
WScript.Echo Join(fileList.ToArray, vbNewLine)
P.P.S:
Is Files collection dynamic:
Set oFSO = CreateObject("Scripting.FileSystemObject")
curDir = CreateObject("WScript.Shell").CurrentDirectory
Set oFolder = oFSO.GetFolder(curDir)
Set oFiles = oFolder.Files
WScript.Echo "Files count: " & oFiles.Count
Set oFile = oFSO.CreateTextFile(oFSO.GetTempName)
oFile.Close
WScript.Echo "Files count: " & oFiles.Count
[EDIT] But looks like then iterate VBS use snapshot of Files collection, so we can presume that unzip may go safety without need of file list.
As you have the files in a collection already (colFiles), the first reason to have a collection of items - process them in turn - does not make you put them in a second list. Why not just unzip each file instead of putting it in a list? To unzip a file A you don't need info about/access to the other files X in the folder. So the second reason for a collection - needing all elements at the same time/when processing one item - doesn't apply either.
If you insist on a second list, all depends on what you want to do with it/the items. If you just want a list of names, the easiest way would be to put the names/pathes as keys in a Dictionary. If you want the names sorted, a System.Collections.ArrayList/SortedList will be more convenient. If you want to work with more properties/attributes of the files - size, dates, access rights, ... - a Disconnected ADODB Recordset will allow you to store all those properties in a (SQL) Table.
Last, but not least, a simple native VBScript Array (dimensioned for the attributes for each file) could be used: As you know the possible number of elements (colFiles.Count), you can define the size of the array before the loop, assign the items in the loop, and ReDim Preserve it after looping.
Take your pick, and I'll add sample code to this posting.
P.S.:
As #Panayot gave you sample code for Arrays and ArrayLists, it would make sense to ask for an ADO Recordset.
P.P.S:
For worriers:
Dim oFS : Set oFS = CreateObject( "Scripting.FileSystemObject" )
Dim sDir : sDir = "..\testdata\testFilesCollection"
Dim nFile, sFile, oFile, i
If oFS.FolderExists( sDir ) Then oFS.DeleteFolder sDir
oFS.CreateFolder sDir
WScript.Echo "----- Creating", cnMax, "files"
For nFile = 1 To cnMax
sFile = nFile & ".txt"
oFS.CreateTextFile oFS.BuildPath( sDir, sFile )
WScript.Echo sFile, "created"
Next
WScript.Echo "----- Looping over", cnMax, "files and creating", cnMax, "more"
i = 0
For Each oFile In oFS.GetFolder( sDir ).Files
If i <= cnMax Then
sFile = Chr(65 + i) & ".txt"
oFS.CreateTextFile oFS.BuildPath( sDir, sFile )
End If
i = i + 1
WScript.Echo oFile.Name, "seen", sFile, "created"
Next
WScript.Echo "----- Looping over", 2 * cnMax, "files"
For Each oFile In oFS.GetFolder( sDir ).Files
WScript.Echo oFile.Name, "seen"
Next
output:
----- Creating 3 files
1.txt created
2.txt created
3.txt created
----- Looping over 3 files and creating 3 more
2.txt seen A.txt created
3.txt seen B.txt created
1.txt seen C.txt created
----- Looping over 6 files
B.txt seen
2.txt seen
C.txt seen
A.txt seen
3.txt seen
1.txt seen
[The files collection is a snapshot] == #Panayot's argument/evidence ==> The For Each loops over a snapshot of the Files collection - at least wrt additions. Testing for deletions is left as an exercise.