Skip corrupt files in a list

[Joe9238]

Hi, I have a long code below that lists links to all files in a folder and then skips through all the links in the list and opens them so long as they are an xls file and have a sheet called 'QUOTES'. When open, it then copies and pastes some data into the main workbook. The problem is that it will not open files that are corrupt. Because there are literally tonnes of files, it wouldn't be easy to weed them all out individually. Instead, is it possible to skip over any files that will not open? All guidance is appreciated greatly

Sub GatherData()Range("A1").Value = "Quoted By"
Range("B1").Value = "Quoted On"
Range("C1").Value = "Client Name"
Range("D1").Value = "Email Address"


Call PasteLinks
    Dim wbTarget As Workbook
    Dim ary(3) As Variant
    Dim lRow As Long
    Dim CodeNames As Variant, i As Long


CodeNames = Range("Z2:Z" & Cells(Rows.Count, "Z").End(xlUp).Row)
Application.ScreenUpdating = False
For i = 1 To UBound(CodeNames, 1)
    If InStr(1, CodeNames(i, 1), ".xls") > 0 Then
    On Error GoTo linemarker3
        If Not WorkbookOpen(CStr(Split(CodeNames(i, 1), "\")(UBound(Split(CodeNames(i, 1), "\"))))) Then


            Set wbTarget = Workbooks.Open(CodeNames(i, 1))
              For Each Sheet In wbTarget.Sheets
      If Sheet.Name = "QUOTE" Then
         With ThisWorkbook.Worksheets(1)
         .Range("Z1").Value = "1"
         End With
         Exit For
      End If
   Next Sheet
            With ThisWorkbook.Worksheets(1)
         If .Range("Z1").Value = "1" Then GoTo linemarker1 Else GoTo linemarker2
         End With
            
linemarker1: With ThisWorkbook.Worksheets(1)
         .Range("Z1").Value = "0"
         End With
            With wbTarget.Worksheets("Quote")
                ary(0) = .Range("B7")
                ary(1) = .Range("B8")
                ary(2) = .Range("B11")
                ary(3) = .Range("B13")
            End With
        Else
            Set wbTarget = Workbooks(CStr(Split(CodeNames(i, 1), "\")(UBound(Split(CodeNames(i, 1), "\")))))
            With wbTarget.Worksheets("Quote")
                ary(0) = .Range("B7")
                ary(1) = .Range("B8")
                ary(2) = .Range("B11")
                ary(3) = .Range("B13")
            End With
        End If
        If ary(0) = "" Then
        ary(0) = "Result not found"
        End If
         If ary(1) = "" Then
        ary(1) = "Result not found"
        End If
         If ary(2) = "" Then
        ary(2) = "Result not found"
        End If
         If ary(3) = "" Then
        ary(3) = "Result not found"
        End If
        With ThisWorkbook.Worksheets(1)
            lRow = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Row
            .Range("A" & lRow & ":D" & lRow) = ary
        End With
linemarker2:         With ThisWorkbook.Worksheets(1)
         .Range("Z1").Value = "0"
         End With
        wbTarget.Close SaveChanges:=False
linemarker3:    End If
Next i
Application.ScreenUpdating = True
    Columns("Z:Z").Select
    Selection.ClearContents
    Range("A1").Select


End Sub
Function WorkbookOpen(WorkBookName As String) As Boolean
    WorkbookOpen = False
    On Error GoTo linemarker4
    If Len(Application.Workbooks(WorkBookName).Name) > 0 Then
        WorkbookOpen = True
        Exit Function
    End If
linemarker4:
End Function
Sub PasteLinks()


  Dim FileSystem As Object
  Dim HostFolder As String


    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder..."
        .Show
        If .SelectedItems.Count > 0 Then
            HostFolder = .SelectedItems(1) & "\"
    End If
    End With
    On Error Resume Next
  Set FileSystem = CreateObject("Scripting.FileSystemObject")
  DoFolder FileSystem.getfolder(HostFolder)
End Sub


Sub DoFolder(Folder)


  Dim SubFolder
  For Each SubFolder In Folder.Subfolders
    DoFolder SubFolder
  Next


  i = Cells(Rows.Count, 26).End(xlUp).Row + 1
  Dim File
  For Each File In Folder.files
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 26), Address:= _
        File.Path, TextToDisplay:=File.Path
    i = i + 1


  Next


End Sub


Sub openworkbook()
On Error GoTo linemarker3
CodeNames = Range("Z2:Z" & Cells(Rows.Count, "Z").End(xlUp).Row)
Set wbTarget = Workbooks.Open(CodeNames(i, 1))
End Sub

The area that is highlighted as unable to open the corrupt file is:

Set wbTarget = Workbooks.Open(CodeNames(i, 1))

Thanks in advance