0

我得到运行时错误 53：找不到第 27-28 个项目的文件。知道有什么问题吗？

错误在于：

“FileCopy 源：=SourcePath，目标：=DestinationPath”

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
4

2 回答 2

1

尝试

Sub LoopThroughFolder()
  on error resume next
  .....
于 2013-04-19T04:25:50.607 回答
0

我添加了一个函数fileExist，如果路径存在，它将为真。在调用此行“FileCopy Source:=SourcePath, Destination:=DestinationPath”之前，最好检查它们是否存在，如果存在则继续进行文件复制。

Option Base 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
于 2013-04-19T04:33:06.297 回答