vbscript，在文件名中查找匹配项 [英] vbscript, find matches in filenames

问题描述

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

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.

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

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.

推荐答案

啊，现在我明白了.所以:如果至少有 6 个文件具有相同的匹配子字符串，则需要与模式匹配的所有文件名.好的.然后，是的，我知道您可能会陷入嵌套的 for..next 循环中.如果发生这种情况，我建议将一些代码放入额外的函数中.
在这个解决方案中，我使用字典来做一些更容易的工作(例如，每次调用exists"都是对其所有元素的另一个嵌套迭代，以及每个赋值).
此示例将忽略一个文件名内的多个匹配项.

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)

---我的第一个回答

好吧，我可能应该问你尝试了什么但是...这是你的例子^^.这应该给你足够的开始(我忽略了你提到的6"要求).询问您是否需要更多解释.

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

这篇关于vbscript，在文件名中查找匹配项的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！