Question

我需要一个脚本，一旦有4个相似的文件，就可以移动具有相同名称的文件。

示例：

Cust-12345.txt
Addr-12345.txt
Ship-12345.txt
Price-12345.txt

文件将始终以名称开头，“ - ”后的数字将始终不同。我需要能够搜索文件夹，当所有4个文件都存在时，将它们移动到一个已完成的文件夹中。

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

dim message

message = "Yes"

set dictResultsFinal = CreateObject("Scripting.Dictionary")
set dictResults = CreateObject("Scripting.Dictionary")
set dictResultsCount = CreateObject("Scripting.Dictionary")

Set objFS = CreateObject("Scripting.FileSystemObject")

strShareDirectory = "c:\Test"
strDumpStorageDir = "c\Test\Out"

Set objFolder = objFS.GetFolder(strShareDirectory)
Set colFiles = objFolder.Files

Set re = New RegExp
re.Global     = True
re.IgnoreCase = False
re.Pattern    = "-\d"

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) ) = 4 then


      dictResultsFinal(keyItem) = 1
    end if
end if
next

Answer 1

我在这里有一个答案，涉及使用数组但是，想到它，我认为你甚至不需要一个数组。只需迭代每个文件并检查其他文件是否存在。

Set re = New RegExp
re.Global = True
re.IgnoreCase = True
re.Pattern = "\\(Cust|Addr|Ship|Price)-(\d+)\.txt"

For Each File In objFS.GetFolder(strShareDirectory).Files

    ' Test to make sure the file matches our pattern...
    If re.Test(File.Path) Then

        ' It's a match. Get the number...
        strNumber = re.Execute(File.Path)(0).SubMatches(1)

        ' If all four exist, move them...
        If AllFourExist(strNumber) Then
            For Each strPrefix In Array("Cust-", "Addr-", "Ship-", "Price-")
                objFS.MoveFile strShareDirectory & "\" & strPrefix & strNumber & ".txt", _
                               strDumpStorageDir & "\" & strPrefix & strNumber & ".txt"
            Next
        End If

    End If

Next

这是AllFourExist函数（我假设objFS是全局的）：

Function AllFourExist(strNumber)
    For Each strPrefix In Array("Cust-", "Addr-", "Ship-", "Price-")    
        If Not objFS.FileExists(strShareDirectory & "\" & strPrefix & strNumber & ".txt") Then Exit Function
    Next
    AllFourExist = True
End Function

我不确定FSO将如何处理您将文件从当前正在迭代的文件夹中移出的事实。如果它抱怨，你可能需要诉诸数组。要记住的事情。

用于移动文件的VBScript

1 个答案: