vbscript, find matches in filenames - vbscript

Question

I'm new to vbscripting and I just received a task that requires me to find 6 files with matching strings in the filename so that I can move these files to a different directory. I am using the regex pattern "\d{8}-\d{6}" to locate all of the strings within the filenames.
How would I go about in doing a search in a directory and checking to see if there are 6 files with matching strings in their filenames so that I can store them into an array and then move the files to another directory?
The script I have written so far:
Set objFS = CreateObject("Scripting.FileSystemObject")
strShareDirectory = "in\"
strDumpStorageDir = "out\"
Set objFolder = objFS.GetFolder(strShareDirectory)
Set colFiles = objFolder.Files
Set re = New RegExp
re.Global = True
re.IgnoreCase = False
re.Pattern = "-\d{8}-\d{6}"
Dim curFile, matchValue
Dim i: i = 0
For Each objFile in colFiles
bMatch = re.Test(objFile.Name)
curFile = objFile.Name
If bMatch Then
ReDim preserve matches(i)
Matches(i) = curFile
i = (i + 1)
For Each objFile1 in colFiles
If objFile1.Name <> objFile.Name Then
For each match in re.Execute(objFile1.Name)
matchValue = match.Value
Exit For
Next
If (Instr(curFile, matchValue) > 0) Then
matchCount = 1
For Each match1 in re.Execute(objFile1.Name)
curFile1 = objFile1.Name
matchValue1 = match1.Value
Exit For
'If Then
Next
'msgbox(curFile1)
End If
End If
Next
End If
Next
Here is what my sample directory that I am working with looks like.

Answer 1

As #KekuSemau's proposal does not address the (sub)problem of grouping the files, dweebles does not give the full story (Why the array? Why the insistence on having a full (sub)set of files?), and the numbers (group of 6, 3/4 parts in a file name) aren't really relevant to the basic task - distribute a set files into folders based on parts of the file name - I claim that the way to solve the task is to get rid of all the array, dictionary, and regexp fancies and to keep it simple:
Before:
tree /A /F ..\data
+---in
| B-2
| B-1
| A-3
| A-2
| B-3
| A-1
|
\---out
Code:
Const csSrc = "..\data\in"
Const csDst = "..\data\out"
Dim f, n, d
For Each f In goFS.GetFolder(csSrc).Files
n = Split(f.Name, "-")
If 1 = UBound(n) Then
d = goFS.BuildPath(csDst, n(1))
If Not goFS.FolderExists(d) Then goFS.CreateFolder d
f.Move goFS.BuildPath(d, f.Name)
End If
Next
After:
tree /A /F ..\data
+---in
\---out
+---3
| A-3
| B-3
|
+---1
| B-1
| A-1
|
\---2
B-2
A-2
P.S.
This problem can be solved using the same approach.

Answer 2

Ah, now I understand.
So: you need all file names that match the pattern IF there are at least 6 files with the same matching sub string. Okay. Then, yes, I understand that you can get strangled up in nested for..next loops. If that happens, I would recommend to put some code into extra functions.
In this solution, I use dictionaries to do some work much easier (every call to 'exists' is another nested iteration over all its elements for example, and every assignment as well).
This example would ignore multiple matches within one file name.
option explicit
dim objFS : dim strShareDirectory : dim strDumpStorageDir : dim objFolder : dim colFiles : dim re : dim objFile
dim dictResults ' dictionary of [filename] -> [matching substring]
dim dictResultsCount ' dictionary of [matching substring] -> [count]
dim dictResultsFinal ' only the valid entries from dictResults
dim keyItem
dim strMatch
set dictResultsFinal = CreateObject("Scripting.Dictionary")
set dictResults = CreateObject("Scripting.Dictionary")
set dictResultsCount = CreateObject("Scripting.Dictionary")
Set objFS = CreateObject("Scripting.FileSystemObject")
strShareDirectory = "in\"
strDumpStorageDir = "out\"
Set objFolder = objFS.GetFolder(strShareDirectory)
Set colFiles = objFolder.Files
Set re = New RegExp
re.Global = True
re.IgnoreCase = False
re.Pattern = "-\d{8}-\d{6}"
Dim curFile, matchValue
Dim i: i = 0
For Each objFile in colFiles
' test if the filename matches the pattern
if re.test(objFile.Name) then
' for now, collect all matches without further checks
strMatch = re.execute(objFile.Name)(0)
dictResults(objFile.Name) = strMatch
' and count
if not dictResultsCount.Exists(strMatch) then
dictResultsCount(strMatch) = 1
else
dictResultsCount(strMatch) = dictResultsCount(strMatch) +1
end if
end if
next
' for testing: output all filenames that match the pattern
msgbox join(dictResults.keys(), vblf)
' now copy only the valid entries into a new dictionary
for each keyItem in dictResults.keys()
if dictResultsCount.Exists( dictResults(keyItem) ) then
if dictResultsCount( dictResults(keyItem) ) >= 6 then
dictResultsFinal(keyItem) = 1
end if
end if
next
' test output the final result
msgbox join(dictResultsFinal.keys(), vblf)
--- my first answer
Well I should probably ask what have you tried but... here's your example ^^.
This should give you enough to start from (I ignored that '6' requirements you mentioned). Ask if you need more explanations.
Option explicit
dim a
a = findFiles("G:\", "\d{8}-\d{6}")
msgbox join(a, vblf)
function findFiles(path, pattern)
dim rx
dim fso
dim fsoFolder
dim fsoFiles
dim results
dim item
set rx = new regexp
rx.pattern = pattern
set results = CreateObject("Scripting.Dictionary")
set fso = CreateObject("Scripting.FileSystemObject")
set fsoFolder = fso.GetFolder(path)
set fsoFiles = fsoFolder.Files
for each item in fsoFiles
if rx.test(item.name) then results(item.name) = 1
next
set fso = nothing
set fsoFolder = nothing
set fsoFiles = nothing
findFiles = results.keys()
end function