Question

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

我还想计算源文件，递归文件夹并移动pdf（忽略大小写）文件，计算目标文件。如果源和目标相等，则运行dir * .pdf＆gt; 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

编辑原始代码以获取更多帮助。谢谢Zoyd

天文

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并在那里移动文件）。

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

1 个答案: