Question

我正在使用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

Answer 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

使用VBScript复制和粘贴文件

1 个答案: