Question

我是vbscripting的新手，我刚收到一个任务，要求我找到6个文件名中包含匹配字符串的文件，以便我可以将这些文件移动到不同的目录。我使用正则表达式模式“\ d {8} - \ d {6}”来找到文件名中的所有字符串。

我如何在目录中搜索并检查是否有6个文件在其文件名中包含匹配的字符串，以便我可以将它们存储到数组中然后将文件移动到另一个目录？

到目前为止我写的脚本：

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

以下是我正在使用的示例目录。 enter image description here

Answer 1

由于@KekuSemau的提议没有解决分组文件的（子）问题，dweebles没有给出完整的故事（为什么数组？为什么坚持拥有完整的（子）文件集？），以及数字（文件名中的6个，3个/ 4个部分组）与基本任务并不真正相关 - 根据文件名的部分将文件集分配到文件夹中 - 我声称解决任务的方法是摆脱所有数组，字典和正则表达式的幻想，并保持简单：

在：

tree /A /F ..\data
+---in
|       B-2
|       B-1
|       A-3
|       A-2
|       B-3
|       A-1
|
\---out

代码：

  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

后：

tree /A /F ..\data
+---in
\---out
    +---3
    |       A-3
    |       B-3
    |
    +---1
    |       B-1
    |       A-1
    |
    \---2
            B-2
            A-2

<强> P.S。可以使用相同的方法解决此problem。

Answer 2

啊，现在我明白了。所以：你需要所有与模式匹配的文件名如果至少有6个文件具有相同的匹配子字符串。好的。然后，是的，我明白你可以在嵌套的for..next循环中被勒死。如果发生这种情况，我建议将一些代码放入额外的功能中在这个解决方案中，我使用字典来更轻松地完成一些工作（每次调用'exists'都是对其所有元素的另一个嵌套迭代，例如，每个赋值也是如此）。
此示例将忽略一个文件名中的多个匹配。

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)

---我的第一个答案

好吧，我应该问你尝试了什么但是......这是你的例子^^。这应该足以让你开始（我忽略了你提到的'6'要求）。询问您是否需要更多解释。

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

vbscript，在文件名中查找匹配项

2 个答案: