用于移动类似文件的 VBScript

Posted 2023-03-29

【中文标题】用于移动类似文件的 VBScript

【英文标题】：VBScript for moving like files

【发布时间】：2014-05-03 10:24:45

【问题描述】：

一旦有 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

【问题讨论】：

嗨，欢迎来到 SO -> mattgemmell.com/what-have-you-tried 你还试过什么。

我试过这个，但我不知道在我验证了 4 个文件之后如何移动它们。

好的，让我们看看到目前为止您为查找文件而编写的代码。

如何显示我的代码，它说的字符太多？

【参考方案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 将如何处理您将文件移出当前正在迭代的文件夹这一事实。如果它抱怨，你可能需要求助于数组。需要记住的一点。