Excel 2016, Foutmelding 1004, maar reden onbekend

[tijmen_4real]

Hoi,

Via onderstaande code laat ik in (onderliggende) mappen zoeken naar data uit cellen en deze worden in een statuslijst geladen.
Werkt prima als ik de code test, maar aan het eind van de macro krijg ik toch de 1004 foutmelding.

Sub InfoVerzamelen()

  Dim j As Long, jj As Long, it, fl
  Dim wb As Workbook
  
  'c00 = locatie waar naar bestanden te zoeken
  c00 = "eventjes leeggelaten voor dit voorbeeld"
  
  'constante screen updating uitschakelen
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  ReDim ar(0) As String
  
  'mappen doorzoeken naar bestanden
  With CreateObject("Scripting.FileSystemObject").getFolder(c00)
  
    'submappen zoeken naar bestanden
    For Each it In .subfolders
    
      'zoeken naar bestanden
      For Each fl In it.Files
      
        'hit als bestand .xlsm extensie heeft, dan...
        If LCase(Right(fl.Path, 5)) = ".xlsm" Then
        
        Dim LastRow As Long
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
          
          Set wb = Workbooks.Open(fileName:=fl.Path)
          
          ThisWorkbook.Sheets(1).Range("A" & LastRow).Value = wb.Worksheets(1).Range("L2").Value
      ThisWorkbook.Sheets(1).Range("B" & LastRow).Value = wb.Worksheets(1).Range("AA2").Value
      ThisWorkbook.Sheets(1).Range("C" & LastRow).Value = wb.Worksheets(1).Range("W122").Value
      ThisWorkbook.Sheets(1).Range("D" & LastRow).Value = wb.Worksheets(1).Range("R117").Value
      ThisWorkbook.Sheets(1).Range("E" & LastRow).Value = wb.Worksheets(1).Range("P29").Value
      ThisWorkbook.Sheets(1).Range("F" & LastRow).Value = Left(wb.Worksheets(1).Range("P28").Value, 20)
      ThisWorkbook.Sheets(1).Range("G" & LastRow).Value = wb.Worksheets(1).Range("P30").Value
      ThisWorkbook.Sheets(1).Range("H" & LastRow).Value = Left(wb.Worksheets(1).Range("A78").Value, 25)
      ThisWorkbook.Sheets(1).Range("I" & LastRow).Value = wb.Worksheets(1).Range("Y25").Value
      ThisWorkbook.Sheets(1).Range("J" & LastRow).Value = Left(wb.Worksheets(1).Range("P25").Value, 16)
      ThisWorkbook.Sheets(1).Range("K" & LastRow).Value = Left(wb.Worksheets(1).Range("J104").Value, 1)
      ThisWorkbook.Sheets(1).Range("L" & LastRow).Value = Left(wb.Worksheets(1).Range("J102").Value, 1)
      ThisWorkbook.Sheets(1).Range("M" & LastRow).Value = wb.Worksheets(1).Range("J108").Value
      ThisWorkbook.Sheets(1).Range("N" & LastRow).Hyperlinks.Add Anchor:=.Range("a5"), Address:=fl.Path, TextToDisplay:="Openen"
          
        'Save and Close Workbook
        wb.Close SaveChanges:=True

        End If
      Next fl
    Next it
    
    
  End With
  
ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
Sheets(1).Range("A2:O300").Font.Size = 8
Sheets(1).Range("A:O").AutoFit
  
End Sub

De reden voor de foutmelding is mij onbekend.
Wat is er mis?

 

[edmoor]

Zou handig zijn als je er ook bij verteld op welke regel je die melding krijgt.

 

[VenA]

En op welke regel krijg je de foutmelding? Al maakt de naam van variabelen niet zo zoveel uit, jij gebruikt ze wel erg bijzonder net als het wegschrijven van de data. Al eens gehoord van With en End With? Bij een lege map zal het denk ik fout gaan.

Sub VenA()
  c00 = "E:\Temp\"
  With CreateObject("Scripting.FileSystemObject").getFolder(c00)
    For Each fl In .subfolders
      If fl.Files.Count Then
        For Each it In fl.Files
          If LCase(Right(it.Path, 5)) = ".xlsm" Then
            With GetObject(it.Path).Sheets(1)
              ar = Array(.Range("L2").Value, .Range("AA2").Value, .Range("W122").Value, .Range("R117").Value, .Range("P29").Value, Left(.Range("P28").Value, 20), .Range("P30").Value _
              , Left(.Range("A78").Value, 25), .Range("Y25").Value, Left(.Range("P25").Value, 16), Left(.Range("J104").Value, 1), Left(.Range("J102").Value, 1), .Range("J108").Value)
              .Parent.Close 0
            End With
            With ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
              .Resize(, 13) = ar
              .Offset(, 13).Hyperlinks.Add Anchor:=.Offset(, 13), Address:=it.Path, TextToDisplay:="Openen"
            End With
          End If
        Next it
      End If
    Next fl
  End With
End Sub

 

[HSV]

.Hyperlinks.Add Anchor:=.Offset(, 13), Address:=it.Path, TextToDisplay:="Openen"

Is voldoende, maar eigenlijk:

.parent.Hyperlinks.Add Anchor:=.Offset(, 13), Address:=it.Path, TextToDisplay:="Openen"