Question

我收到运行时错误53：找不到第27-28项的文件。知道什么是错的吗？

错误在于：

“FileCopy Source：= Source Path，Destination：= Destination Path”

Option Base 1
Sub LoopThroughFolder()

    Const FileSpec As String = "*.xls"
    Dim y As Integer
    Dim MyFolder As String
    Dim MyFile As String
    Dim iDot As Integer
    Dim FileRoot As String
    Dim FileExt As String

    Dim SourcePath As String
    Dim DestinationPath As String

    Dim ArrayData() As Variant
    Dim Series() As Integer


    'Capture the filename information
    For y = 2009 To 2030
        ReDim Preserve ArrayData(12, y)
        ReDim Preserve Series(12, y)
        MyFolder = ActiveWorkbook.Path & "\" & y & "\"

        i = 1
        MyFile = Dir(MyFolder & FileSpec)
        Do While Len(MyFile) > 0
            iDot = InStrRev(MyFile, ".")

            If iDot = 0 Then
                FileRoot = MyFile
                FileExt = ""
            Else
                FileRoot = Left(MyFile, iDot - 1)
                FileExt = Mid(MyFile, iDot - 1)
            End If

            MyFile = Dir
            ArrayData(i, y) = FileRoot
            i = i + 1
        Loop
    Next y

    'Conversion from MMMYY to numerical sequence
    a = 1
    BasicPath = ActiveWorkbook.Path
    For y = 2009 To 2030
        For i = 1 To 12
            If Not IsEmpty(ArrayData(i, y)) Then
                Series(i, y) = a
                a = a + 1

                SourcePath = BasicPath & "\" & y & "\" & ArrayData(i, y) & ".xls"
                DestinationPath = BasicPath & "\output\" & "Bill_Summary_Report_" & Series(i, y) & ".xls"

                FileCopy Source:=SourcePath, Destination:=DestinationPath

            Else
                x = 0
            End If
        Next i
    Next y

End Sub

Answer 1

试

Sub LoopThroughFolder()
  on error resume next
  .....

Answer 2

我添加了一个函数 fileExist ，如果路径存在，它将为true。在此行“FileCopy Source：= SourcePath，Destination：= DestinationPath”被调用之前，最好先检查它们是否存在，如果是，则继续使用filecopy。

选项基础1 Sub LoopThroughFolder（）

    Const FileSpec As String = "*.xlsm"
    Dim y As Integer
    Dim MyFolder As String
    Dim MyFile As String
    Dim iDot As Integer
    Dim FileRoot As String
    Dim FileExt As String

    Dim SourcePath As String
    Dim DestinationPath As String

    Dim ArrayData() As Variant
    Dim Series() As Integer


    'Capture the filename information
    For y = 2009 To 2030
        ReDim Preserve ArrayData(12, y)
        ReDim Preserve Series(12, y)
        MyFolder = ActiveWorkbook.path & "\" & y & "\"

        i = 1
        MyFile = Dir(MyFolder & FileSpec)
        Do While Len(MyFile) > 0
            iDot = InStrRev(MyFile, ".")

            If iDot = 0 Then
                FileRoot = MyFile
                FileExt = ""
            Else
                FileRoot = Left(MyFile, iDot - 1)
                FileExt = Mid(MyFile, iDot - 1)
            End If

            MyFile = Dir
            ArrayData(i, y) = FileRoot
            i = i + 1
        Loop
    Next y

    'Conversion from MMMYY to numerical sequence
    a = 1
    BasicPath = ActiveWorkbook.path
    For y = 2009 To 2030
        For i = 1 To 12
            If Not IsEmpty(ArrayData(i, y)) Then
                Series(i, y) = a
                a = a + 1

                SourcePath = BasicPath & "\" & y & "\" & ArrayData(i, y) & ".xls"
                DestinationPath = BasicPath & "\output\" & "Bill_Summary_Report_" & Series(i, y) & ".xls"

                If fileExist(SourcePath) And fileExist(DestinationPath) Then
                    FileCopy Source:=SourcePath, Destination:=DestinationPath
                End If

            Else
                x = 0
            End If
        Next i
    Next y

End Sub

Function fileExist(path As String) As Boolean
    On Error Resume Next

    Dim file As String
    file = Dir(path)

    If file <> "" Then fileExist = True

    On Error GoTo 0
End Function

如何忽略错误并继续循环？

2 个答案: