Есть ли способ пропустить ошибку "имя файла не найдено" и перейти к следующему файлу

Question

Здравствуйте, у меня есть новый вопрос по тому же коду.Я внес небольшие изменения в код для разных целей.Итак, вот код на данный момент.

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

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

Вот функция, которая может проверить, существует ли файл:

'********************************************************************************************************************************
' 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 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

Вы можете обойти это, создав второй 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