使用 vbscript 递归地将文件从子文件夹移动到另一个文件夹

Question

我需要递归一个文件夹和所有子文件夹并将 pdf 文件移动到另一个文件夹。看这里我尝试了以下，但它似乎在持续运行（脚本永远不会结束），但它确实移动了文件。

我还想计算源文件、递归文件夹和移动 pdf（忽略大小写）文件、计算目标文件。如果源和目标相等，则运行 dir *.pdf > trust.csv 并发送成功电子邮件

Set fso = CreateObject("Scripting.FileSystemObject")
Set Message = CreateObject("CDO.Message")
Set Shell = WScript.CreateObject("WScript.Shell")
Set shell = CreateObject("Wscript.shell")


'Specify variables for Emails
strScriptServer = "ASFOXTECHOPS01"
strScriptPath = "\\techopspc01\c$\scripts\WM..."
strScriptName = "[WM-01]-WMScansToCenterDoc.vbs"
'strToEmail = ""
strCCEmail = ""
strCCEmailFail = ""
strProcessID = "[WM-01]"
strCustomerImpact = "LOW"
strCorporateImpact = "LOW"
strDocumentation = "\\FSCHAFOX01\GROUP_SHARE\Tech Group\Documentation\Automation\"
blnEmailNotification = false

'Specify variables for File Paths
'strFromPath1 = "\\fschauni01\GROUP_SHARE\Wealth Management\Scanning\ZAstrosky\"
strToPath1 = "\\fschauni01\GROUP_SHARE\Wealth Management\Tech\"
strToArchive1 = "\\fschauni01\GROUP_SHARE\Wealth Management\Scanning\" & StrYear & "_" & strMonth

'BROKE************CREATE ARCHIVE FOLDER IF IT DOES NOT EXIST
'If FSO.FolderExists(strToArchive1) Then
        'Proceed
'Else
'       FSO.CreateFolder("\\fschauni01\GROUP_SHARE\Wealth Management\Scanning\" & StrYear & "_" & strMonth)
'End If

'DELETE FILES FROM THE strToPath(s) TO AVOID OVERWRITE ERRORS
FSO.DeleteFile (strToPath1 & "*.*")

testfolder = "\\fschauni01\GROUP_SHARE\Wealth Management\Tech\"
MoveFiles fso.GetFolder("\\fschauni01\GROUP_SHARE\Wealth Management\Scanning\ZAstrosky")
blnEmailNotification = True 

'Email
'If Err <> 0 Then
'   blnEmailNotification = false
'   HandleError
'End If     

If blnEmailNotification = True Then
            'Send Results email
            objMessage.Subject = "SUCCESS - " & strProcessID & " - WM Scanned Reports Imported into CenterDoc"
            objMessage.From = "IT Automation"
            objMessage.Sender = ""
            'objMessage.To = strToEmail
            objMessage.Cc = strCCEmail
            objMessage.TextBody = "---------------SCRIPT SUCCESSFUL---------------" & vbnewline & VbCrLf & "Script successfully moved the files with no errors." & vbnewline & vbcrlf & "- Script Name:" & VbTab & VbTab & VbTab & strScriptName & VbNewLine & VbCrLf & "- Script Origination:" & VbTab & VbTab & strScriptServer & VbNewline & VbCrLf & "- Script Path:" & VbTab & VbTab & VbTab & strScriptPath & VbNewLine & VbCrLf & "- Documentation:" & VbTab & VbTab & strDocumentation & VbNewLine & VbCrLf & "- Set1:" &VbTab & VbTab & "Souce Files = " & sourcecount1 & VbTab & VbTab & "Destination Files = " & destcount1 & VbTab & VbTab & "Archive Files = " & archivecount1 & VbTab & VbTab & "------------------------------------------------------------"
            objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = ""
            objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            objMessage.Configuration.Fields.Update
            objMessage.Send
Else
    'Do Nothing
End If

Sub HandleError
    strErrorMessage = "Error Number " & Err.Number & ":" & Err.Description 
    objMessage.Subject = "SCRIPT ERROR - " & strProcessID & " - IMMEDIATE ACTION REQUIRED"
    objMessage.From = "IT Automation"
    objMessage.Sender = ""
    objMessage.To = strToEmail
    'objMessage.Cc = strCCEmail
    objMessage.TextBody = "---------------SCRIPT ERROR---------------" & vbnewline & VbCrLf & "Script Name:" & VbTab & VbTab & VbTab & strScriptName & VbNewLine & VbCrLf & "Customer Impact:" & VbTab & VbTab & VbTab & strCustomerImpact & VbNewLine & VbCrLf & "Corporate Impact:" & VbTab & VbTab & VbTab & strCorporateImpact & VbNewLine & VbCrLf & "Error Description:" & VbTab & VbTab & VbTab & Err.Description & vbnewline & VbCrLf & "Error Number:" & VbTab & VbTab & VbTab & Err.Number & VbCrLf & VbNewLine & "Script Location:" & VbTab & VbTab & VbTab & strScriptServer & VbCrLf & VbNewLine & "Script Path:" & VbTab & VbTab & VbTab & strScriptPath & VbNewline & VbCrLf & "Documentation:" & VbTab & VbTab & strDocumentation & VbNewLine & VbCrLf & "-------------------------------------------------"
    objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = ""
    objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objMessage.Configuration.Fields.Update
    objMessage.Send
    Err.Clear
End Sub

Sub MoveFiles(fldr)
For Each f In fldr.Files
    basename  = fso.GetBaseName(f)
    extension = fso.GetExtensionName(f)
    If LCase(extension) = "pdf" Then
        dest  = fso.BuildPath(testfolder, f.Name)
        Do While fso.FileExists(dest)
            dest  = fso.BuildPath(testfolder, basename & "." & extension)
        Loop
        f.Move dest
        End If
    Next
       For Each sf In fldr.SubFolders
         MoveFiles sf
    Next
End Sub

编辑原始代码以获得更多帮助。 谢谢佐伊德

天文

Answer 1

您将所有 pdf 文件从 \\fschauni01\GROUP_SHARE\Wealth Management\Scanning\ZAstrosky 及其子文件夹移动到 \\fschauni01\GROUP_SHARE\Wealth Management\Scanning\ZAstrosky\Tech。您的递归逻辑是合理的，但还有另一个问题：您的目标文件夹是源文件夹的子文件夹。因此，您的脚本不断将文件从\\fschauni01\GROUP_SHARE\Wealth Management\Scanning\ZAstrosky\Tech 复制到自身。无论这是否有效，对集合执行 foreach 循环并修改其内容都是一个坏主意。

主要的问题是这个while循环如果被执行就永远不会结束，在这种情况下，它会被执行。当您的递归到达目标文件夹时，所有文件都已经存在于目标文件夹中（显然），循环被执行并且没有出路。

If LCase(extension) = "pdf" Then
    dest  = fso.BuildPath(testfolder, f.Name)
    Do While fso.FileExists(dest)
        dest  = fso.BuildPath(testfolder, basename & "." & extension)
    Loop
    f.Move dest
End If

至于统计文件的问题，folder.Files.Count不行吗？ （如果你需要递归计数，恐怕你必须自己做，但你知道怎么做）。

编辑后，代码仍然包含以下内容：

Do While fso.FileExists(dest)
        dest  = fso.BuildPath(testfolder, basename & "." & extension) ' ☠
Loop

因此，例如，如果"\\fschauni01\GROUP_SHARE\Wealth Management\Scanning\ZAstrosky\docs1"和"\\fschauni01\GROUP_SHARE\Wealth Management\Scanning\ZAstrosky\docs2"中存在文件a.pdf，您的脚本会发现存档目录中已经存在a.pdf并进入无限循环。解决这个问题的一种方法是在存档目录中重新创建目录结构（每次在 directoryA 上调用 MoveFiles，在存档目录中创建 directoryA 并将文件移动到那里）。