有没有办法跳过错误“找不到文件名”并移动到下一个文件答案

【问题标题】：Is there a way to skip error "filename is not found" and move to the next file有没有办法跳过错误“找不到文件名”并移动到下一个文件
【发布时间】：2019-10-15 06:57:54
【问题描述】：

有没有办法跳过错误“找不到文件名”并移动到下一个文件？

Sub CopyDataAndMoveDown()

Application.ScreenUpdating = False

Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.ActiveSheet
Dim rngToCopy As Range, rngToPaste As Range
Dim x As Long
Dim breakdown1
Dim breakdown As Worksheet: Set breakdown = wb.ActiveSheet

For x = 4 To 504 Step 6

    With wb.Sheets("Sheet1")
        breakdown1 = breakdown.Cells(9, x - 2)
    End With

    If IsEmpty(breakdown1) Then
        Call MoveBelow
    Else

        With wb.Sheets("Sheet1")
            Set rngToCopy = .Range(.Cells(4, x - 2), .Cells(24, x + 3))
            Debug.Print rngToCopy.Address
        End With

        With wb.Sheets("Sheet2")
            Set rngToPaste = .Range(.Cells(4, x - 2), .Cells(rngToCopy.Rows.Count + 3, x + 3))
            Debug.Print rngToPaste.Address
        End With

        rngToPaste = rngToCopy.Value
    End If

Next x

Application.ScreenUpdating = True
MsgBox "Valmis."
End Sub

Sub MoveBelow ()

Application.ScreenUpdating = False

Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.ActiveSheet
Dim rngToCopy As Range, rngToPaste As Range
Dim x As Long
Dim breakdown1
Dim breakdown As Worksheet: Set breakdown = wb.ActiveSheet

For x = 4 To 504 Step 6

    With wb.Sheets("Sheet1")
        breakdown1 = breakdown.Cells(9, x - 2)
    End With

    If IsEmpty(breakdown1) Then
        ' At this point when the macro meet again a empty cell
        ' it should keep moving from the same counted X
        ' but start the paste operation from 24 rows below.
    Else

        With wb.Sheets("Sheet1")
            Set rngToCopy = .Range(.Cells(4, x - 2), .Cells(24, x + 3))
            Debug.Print rngToCopy.Address
        End With

        With wb.Sheets("Sheet2")
            Set rngToPaste = .Range(.Cells(28, x - 2), .Cells(rngToCopy.Rows.Count + 3, x + 3))
            Debug.Print rngToPaste.Address
        End With

        rngToPaste = rngToCopy.Value
    End If

Next x

Application.ScreenUpdating = True
MsgBox "Valmis."
End Sub

因此，当宏将数据从工作表 1 复制/粘贴到工作表 2 并遇到一个空单元格时，它应该继续复制下一个可用数据，但将其粘贴到下方 24 行。

--------在旧问题下方。
我有一个 VBA，它正在打开和关闭该 INDEX 函数获取数据的文件。我的问题是这样的。 VBA 正在从包含完整路径的参考单元格中获取文件名。但是一些参考单元格是空白/零，然后正在运行的 VBA 停止并给我错误“找不到文件名”。有没有办法跳过它并转到下一步？

Sub HaeReseptiTiedot()

Dim myfile As String
Dim myfile1 As String
Dim myfile2 As String
Dim myfile3 As String
Dim myfile4 As String
Dim myfile5 As String
Dim myfile6 As String
Dim myfile7 As String
Dim myfile8 As String
Dim myfile9 As String


myfile = Cells(19, 4).Value
myfile1 = Cells(19, 9).Value
myfile2 = Cells(19, 14).Value
myfile3 = Cells(19, 19).Value
myfile4 = Cells(19, 24).Value
myfile5 = Cells(19, 29).Value
myfile6 = Cells(19, 34).Value
myfile7 = Cells(19, 39).Value
myfile8 = Cells(19, 44).Value
myfile9 = Cells(19, 49).Value

Application.ScreenUpdating = False


Workbooks.Open Filename:=myfile, UpdateLinks:=0
ActiveWorkbook.Close False
Sheets("Aputaulukko 2").Select
Range("D16:G30").Select
Selection.Copy
Sheets("Aputaulukko 3").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Workbooks.Open Filename:=myfile1, UpdateLinks:=0
ActiveWorkbook.Close False
Sheets("Aputaulukko 2").Select
Range("I16:L30").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Aputaulukko 3").Select
Range("G4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

【问题讨论】：

您想在打开文件之前检查文件是否存在。 This 可能有用。此外，虽然这不是你的问题，但你真的想在你的代码中 avoid activate and select。
您正在立即打开和关闭工作簿，...而不在其中执行任何操作。你想用这段代码实现什么？
感谢您的回答和cybernetic.nomad 的提示。 @DarXyde我在另一张表中有INDEX函数，它从打开的文件中获取所需的数据，然后VBA将其作为值复制并粘贴到另一个表中并关闭文件。然后 VBA 正在对下一个查找文件和数据执行此操作，因此在将文件复制到另一个工作表之前，无需将文件打开的时间超过 INDEX 函数获取数据的时间。
哦，对不起大家。现在我提到了为什么你们都这么困惑。我应该写 INDIRECT 函数，而不是 INDEX。对此感到抱歉。

标签： excel vba

【解决方案1】：

我发现处理此问题的最佳方法是使用“On Error”语句。您可以保持非常简单并使用On Error Resume Next，它告诉代码完全跳过错误并移至下一条语句（没有错误）。这样做的主要问题是它涵盖了所有错误，而不仅仅是您当前遇到的特定错误。很难知道是否发生错误/您的代码是否按预期运行。

另一个可以帮助避免上述问题的选项是使用这样的东西：

On Error GoTo ErrH
    'Main Body of Your Code
    Exit Sub 'Use to avoid continuing on to the ErrH section.
ErrH:
    'Some method for handling the error, such as a message box or other notification.

这对于小块代码通常不是必需的，但是当您开始组合您的 subs 和函数时，它可能会挽救生命！

祝你好运！

编辑：如果工作表不需要这些空白，您可以/应该考虑删除这些空白。

【讨论】：

【解决方案2】：

您可以通过创建第二个 Sub 来解决此问题，该 Sub 会打开文件并在文件不存在时处理错误。这样，您仍然可以在主 Sub 中捕获其他错误，而无需进行下一步。示例：

Sub MainSub()

    myFile1 = "C:\Temp\New1.xlsx"
    myFile2 = "C:\Temp\New2.xlsx"
    CheckAndOpen (myFile1)
    CheckAndOpen (myFile2)

End Sub

Sub CheckAndOpen(myFileName As String)

    On Error Resume Next
    Workbooks.Open Filename:=myFileName
    Debug.Print Err.Number, myFileName

End Sub

【讨论】：

【解决方案3】：

我冒昧地重写了您的代码...我仍然不太确定您为什么要立即打开和关闭工作簿，但本质上这就是您的代码目前所做的：

Option Explicit

Sub HaeReseptiTiedot()

Application.ScreenUpdating = False

Dim wbSource As Workbook
Dim wb As Workbook: Set wb = ThisWorkbook 'Or ActiveWorkbook or Workbooks("book name")
Dim ws As Worksheet: Set ws = wb.ActiveSheet 'Or wb.Sheets("Sheet Name")
Dim rngToCopy As Range, rngToPaste As Range
Dim X As Long

For X = 4 To 49 Step 5
    On Error Resume Next
    Set wbSource = Workbooks.Open(FileName:=ws.Cells(19, X), UpdateLinks:=0)
    On Error GoTo 0

    If Not wbSource Is Nothing Then
        wbSource.Close False

        With wb.Sheets("Aputaulukko 2")
            Set rngToCopy = .Range(.Cells(16, X), .Cells(30, X + 3))
            'Debug.Print rngToCopy.Address
        End With

        With wb.Sheets("Aputaulukko 3")
            Set rngToPaste = .Range(.Cells(4, X - 2), .Cells(rngToCopy.Rows.Count + 3, X + 1))
            'Debug.Print rngToPaste.Address
        End With

        rngToPaste = rngToCopy.Value
    End If
    Set wbSource = Nothing
Next X

Application.ScreenUpdating = True
End Sub

【讨论】：

感谢您的回答！我要试试这个。立即关闭文件的原因是我有这样的功能： =INDIRECT("'S:\FI\xxx\xxx\xxx[" & $D$16 & "]Resepti'!B11") 它得到了需要数据并将其作为值复制到另一个工作表并在 VBA 进入下一步之前关闭文件。我在开始的帖子中提到我在谈论 INDEX 函数，它应该是 INDIRECT 的。很抱歉。
如果您遇到问题，请告诉我，我可以进一步提供帮助。
试过了，VBA 运行顺利，但在每次打开和关闭文件后，它都没有将数据从“Aputaulukko 2”复制到工作表“Aputaulukko 3”。
请查看更新后的代码 rngToPaste = rngToCopy.Value ...我一直忘记它需要 .Value 才能实际工作。
哇！它完全按照提到的去做。非常感谢朋友！ :)

【解决方案4】：

这是一个可以检查文件是否存在的函数：

'********************************************************************************************************************************
' To check if a particular file exists
' Set excelFile = False, if it is not an Excel file that is being checked
'********************************************************************************************************************************
Public Function isAnExistingFile(ByVal fileNameStr As Variant, Optional ByVal excelFile As Boolean = True) As Boolean
Dim wb As Workbook

isAnExistingFile = True
Err.Clear
On Error GoTo errHandler
If Not VarType(fileNameStr) = vbString Then
    isAnExistingFile = False
ElseIf Len(fileNameStr) = 0 Then
    isAnExistingFile = False
ElseIf Len(Dir(fileNameStr)) = 0 Then
    isAnExistingFile = False
ElseIf ((GetAttr(fileNameStr) And vbDirectory) <> vbDirectory) = False Then
    isAnExistingFile = False
Else
    If excelFile Then
        On Error Resume Next
        Set wb = Application.Workbooks.Open(Filename:=fileNameStr, UpdateLinks:=0, ReadOnly:=True)
        If wb Is Nothing Then isAnExistingFile = False
        If Not wb Is Nothing Then
            wb.Close False
            Set wb = Nothing
        End If
        GoTo Out
    End If
End If

errHandler:
If Not Err.Number = 0 Then isAnExistingFile = False

Out:
Err.Clear: On Error GoTo 0

End Function

【讨论】：

【解决方案5】：

您也可以在代码中添加以下内容：

If dir("FILENAME") <> "" Then
 Add the rest of your code
End If

我通常使用不同的变量在彼此内部运行 3 或 4 个 for 循环以获取每个文件的完整路径，然后将其放置以确保我不会打开有空白的文件。

【讨论】：