有没有一种方法可以跳过错误“找不到文件名”并移至下一个文件

Question

我有一个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

Answer 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.

这通常不需要一小段代码，但是当您开始组合子函数和子函数时，它可以节省生命！

祝你好运！

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

Answer 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

Answer 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

Answer 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

Answer 5

出于不同的目的，我对代码做了一些修改。所以这是现在的代码。

Option Explicit

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行中。对不起，我不好意思解释。

Answer 6

或者，您可以将以下内容放入您的代码中：

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

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