使用 VBScript 复制和粘贴文件答案

【问题标题】：Copying and Pasting Files with VBScript使用 VBScript 复制和粘贴文件
【发布时间】：2018-06-15 13:41:58
【问题描述】：

我正在使用 VBScript 浏览文件夹并复制子文件夹中的所有 excel 文件。代码运行良好，直到我遇到一个没有 excel 文件的子文件夹。如何让代码简单地跳过任何不包含 excel 文件的子文件夹？谢谢

代码如下：

Set FSO = CreateObject("Scripting.FileSystemObject")
ShowSubfolders FSO.GetFolder("C:\Users\jonathan\Documents\Prints Tester"), 3 
Const DestinationFile = "C:\Users\jonathan\Documents\TestEnd\*.xls"

'Script that goes into the subfolder to find the files for copying
Sub ShowSubFolders(Folder, Depth)
If Depth > 0 then
    For Each Subfolder in Folder.SubFolders
    'Wscript.Echo Subfolder.Path 
    Dim FolderPath
    FolderPath = Subfolder.Path
    Dim SourceFile 
    SourceFile = FolderPath & "\*.xls"  

    Set fso = CreateObject("Scripting.FileSystemObject")
       'Check to see if the file already exists in the destination folder
        If fso.FileExists(DestinationFile) Then
            'Check to see if the file is read-only
            If Not fso.GetFile(DestinationFile).Attributes And 1 Then 
                'The file exists and is not read-only.  Safe to replace the file.
                fso.CopyFile SourceFile, "C:\Users\jonathan\Documents\TestEnd\", True
            Else 
               'The file exists and is read-only.
               'Remove the read-only attribute
               fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes - 1
               'Replace the file
               fso.CopyFile SourceFile, "C:\Users\jonathan\Documents\TestEnd\", True
               'Reapply the read-only attribute
                fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes + 1
            End If
       Else
           'The file does not exist in the destination folder.  Safe to copy file to this folder.
           fso.CopyFile SourceFile, "C:\Users\jonathan\Documents\TestEnd\", True
      End If
    Set fso = Nothing

    ShowSubFolders Subfolder, Depth -1 
    Next
End if
End Sub

【问题讨论】：

这里值得一读...stackoverflow.com/questions/40585712/…
@Dave 感谢您将我指向该帖子。为了使代码跳过其中没有 excel 文件的文件夹，我所要做的就是添加“On Error Resume Next”

标签： vbscript

【解决方案1】：

为了解决这个问题，我阅读了@Dave 提到的这篇文章中推荐的内容：

Why doesn't FileExists support wildcards?

我只需要一个On Error Resume Next 就可以让代码在出现错误后继续运行。这是完成的工作代码，它将跳过其中没有 excel 文件的文件夹。

Set FSO = CreateObject("Scripting.FileSystemObject")
ShowSubfolders FSO.GetFolder("C:\Users\jonathan\Documents\Prints Tester"), 3 
Const DestinationFile = "C:\Users\jonathan\Documents\TestEnd\*.xls"

'Script that goes into the subfolder to find the files for copying
Sub ShowSubFolders(Folder, Depth)
If Depth > 0 then
    For Each Subfolder in Folder.SubFolders
    'Wscript.Echo Subfolder.Path 
    Dim FolderPath
    FolderPath = Subfolder.Path
    Dim SourceFile 
    SourceFile = FolderPath & "\*.xls"  

    Set fso = CreateObject("Scripting.FileSystemObject")
       'Check to see if the file already exists in the destination folder
        If fso.FileExists(DestinationFile) Then
            'Check to see if the file is read-only
            If Not fso.GetFile(DestinationFile).Attributes And 1 Then 
                'The file exists and is not read-only.  Safe to replace the file.
                fso.CopyFile SourceFile, "C:\Users\jonathan\Documents\TestEnd\", True
            Else 
               'The file exists and is read-only.
               'Remove the read-only attribute
               fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes - 1
               'Replace the file
               fso.CopyFile SourceFile, "C:\Users\jonathan\Documents\TestEnd\", True
               'Reapply the read-only attribute
                fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes + 1
            End If
       Else
           'The file does not exist in the destination folder.  Safe to copy file to this folder.
           On Error Resume Next
           fso.CopyFile SourceFile, "C:\Users\jonathan\Documents\TestEnd\", True
      End If
    Set fso = Nothing

    ShowSubFolders Subfolder, Depth -1 
    Next
End if
End Sub

【讨论】：