Helpmij.nl
Helpmij.nl
Helpmij.nl

Quote

Weergeven resultaten 1 tot 4 van 4

Onderwerp: Excel 2016, Foutmelding 1004, maar reden onbekend

  1. #1
    Vraag is niet opgelost

    Question Excel 2016, Foutmelding 1004, maar reden onbekend

    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.

    Code:
    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?

  2. #2
    Tera Honourable Senior Member edmoor's avatar
    Geregistreerd
    9 september 2000
    Locatie
    Zuid-Holland
    Zou handig zijn als je er ook bij verteld op welke regel je die melding krijgt.
    "It's hardware that makes a machine fast. It's software that makes a fast machine slow. "
    Op rechtstreekse vragen via email of privébericht reageer ik niet. Daar is het forum voor.
    Lees ook: http://www.helpmij.nl/forum/announcement.php?f=5

  3. #3
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    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.

    Code:
    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
    Laatst aangepast door VenA : 13 februari 2020 om 17:06
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  4. #4
    Giga Honourable Senior Member
    Geregistreerd
    18 juli 2008
    Code:
    .Hyperlinks.Add Anchor:=.Offset(, 13), Address:=it.Path, TextToDisplay:="Openen"
    Is voldoende, maar eigenlijk:
    Code:
    .parent.Hyperlinks.Add Anchor:=.Offset(, 13), Address:=it.Path, TextToDisplay:="Openen"
    ____________
    Met vriendelijke groet,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

  5. Dit topic is automatisch gesloten omdat er sinds vier maanden niet meer op gereageerd is.

    Indien gewenst kan de topicstarter een verzoek tot heropening indienen.

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl

Regels
Help

Helpmij.nl en business

Partners
Sponsoren