If-statement in With (loop)

tijmen_4real · 18 okt 2019

Hoi,

Ik heb een bestand met een sub. Deze sub zoekt in (sub)mappen naar .xlsm-bestanden.
Uit deze bestanden haalt de macro data uit specifieke velden naar het (status)bestand.

Nu heb ik geprobeerd om er een conditie in te bouwen die deze data uitbreidt aan de hand van een veld (R43) in een gevonden bestand:
- Als er 1 staat, wordt er één array gevuld met data en in het statusbestand getoond.
- Als er 2 staat, worden er twee arrays, ....blabla

Code:

Sub MergeAllWorkbooks()
  Dim j As Long, jj As Long, it, fl, ar, ar1, ar2, ar3, ar4, ar5
  
  'c00 = locatie waar naar bestanden te zoeken
  c00 = "hier staat dan de locatie"
  
  'constante screen updating uitschakelen
  Application.ScreenUpdating = False
  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
          ar(UBound(ar)) = fl.Path
          ReDim Preserve ar(UBound(ar) + 1)
        End If
      Next fl
    Next it
    
    If UBound(ar) Then
      ReDim ar1(UBound(ar) - 1, 22)
      For j = 0 To UBound(ar) - 1
        With GetObject(ar(j)).Sheets(1)
        'als er 1 monster gevonden is: samplenr/leverancier/productnaam/productnr/chargenr/categorie/artnr intern/status
        If .[R43].Value = "1" Then
          ar2 = Array(.[D45].Value, .[H45].Value, .[O45].Value, .[AA45].Value, .[H50].Value, .[J105].Value, .[D189].Value, .[J173].Value)
        ElseIf .[R43].Value = "2" Then
        'als er 2 monsters gevonden zijn: samplenr/leverancier/productnaam/productnr/chargenr/categorie/artnr intern/status
          ar2 = Array(.[D45].Value, .[H45].Value, .[O45].Value, .[AA45].Value, .[H50].Value, .[J105].Value, .[D189].Value, .[J173].Value)
          ar3 = Array(.[D46].Value, .[H46].Value, .[O46].Value, .[AA46].Value, .[H51].Value, .[P105].Value, .[D189].Value, .[P173].Value)
        ElseIf .[R43].Value = "3" Then
        'als er 3 monsters gevonden zijn: samplenr/leverancier/productnaam/productnr/chargenr/categorie/artnr intern/status
          ar2 = Array(.[D45].Value, .[H45].Value, .[O45].Value, .[AA45].Value, .[H50].Value, .[J105].Value, .[D189].Value, .[J173].Value)
          ar3 = Array(.[D46].Value, .[H46].Value, .[O46].Value, .[AA46].Value, .[H51].Value, .[P105].Value, .[D189].Value, .[P173].Value)
          ar4 = Array(.[D47].Value, .[H47].Value, .[O47].Value, .[AA47].Value, .[H52].Value, .[V105].Value, .[D189].Value, .[V173].Value)
        ElseIf .[R43].Value = "4" Then
        'als er 4 monsters gevonden zijn: samplenr/leverancier/productnaam/productnr/chargenr/categorie/artnr intern/status
          ar2 = Array(.[D45].Value, .[H45].Value, .[O45].Value, .[AA45].Value, .[H50].Value, .[J105].Value, .[D189].Value, .[J173].Value)
          ar3 = Array(.[D46].Value, .[H46].Value, .[O46].Value, .[AA46].Value, .[H51].Value, .[P105].Value, .[D189].Value, .[P173].Value)
          ar4 = Array(.[D47].Value, .[H47].Value, .[O47].Value, .[AA47].Value, .[H52].Value, .[V105].Value, .[D189].Value, .[V173].Value)
          ar5 = Array(.[D48].Value, .[H48].Value, .[O48].Value, .[AA48].Value, .[H53].Value, .[AB105].Value, .[D189].Value, .[AB173].Value)
        End If
          .Parent.Close 0
        End With
      Next j
      'locatie bepalen waar data te plaatsen
      ActiveWorkbook.Sheets(1).Cells(2, 1).Resize(UBound(ar1) + 1, 23) = ar1
    End If
  End With
End Sub

Werk helaas niet. Het lijkt erop dat ik geen if-else statement kan/mag toevoegen na de With, want hier gaat het fout (na F8 controle).
Wat doe ik verkeerd? En nog belangrijker: hoe kan ik dit wel bereiken?
Groet,

Tijmen

VenA · 18 okt 2019

Hoe staat het hiermee? https://www.helpmij.nl/forum/showthread.php/949398-Fout-91-tijdens-uitvoering-Objectvariabele-of-klokvariabele-With-is-niet-ingesteld

Plaats eens een voorbeeldbestand met wat wat waar staat en wat het resultaat moet worden.

Haije · 18 okt 2019

Code:

[COLOR="#FF0000"][SIZE=5].[/SIZE][/COLOR]fl.Path

ipv

Code:

fl.Path

?

VenA · 18 okt 2019

Maar even de code van @snb uit jouw vorige draadje wat aangepast naar de nieuwe wens.

Code:

Sub VenA()
  c00 = "E:\Temp\Temp\"
  ar = Split(CreateObject("wscript.shell").Exec("cmd /c dir " & c00 & "*.xlsm /b/s").StdOut.ReadAll, vbCrLf)
  Set d = CreateObject("Scripting.Dictionary")
  For j = 0 To UBound(ar) - 1
    With GetObject(ar(j))
      ar2 = .Sheets(1).Range("A1:AB189").Value
      .Close 0
    End With
    For y = 1 To ar2(43, 18)
      d(d.Count + 1) = Array(ar2(y + 44, 4), ar2(y + 44, 8), ar2(y + 44, 15), ar2(y + 44, 27), ar2(y + 49, 8), ar2(105, 4 + y * 6), ar2(189, 4), ar2(173, 4 + y * 6))
    Next y
  Next j
  Sheet2.Cells(1).Resize(d.Count, 8) = Application.Index(d.items, 0, 0)
End Sub

tijmen_4real · 21 okt 2019

VenA zei:

Maar even de code van @snb uit jouw vorige draadje wat aangepast naar de nieuwe wens.

Code:

Sub VenA()
  c00 = "E:\Temp\Temp\"
  ar = Split(CreateObject("wscript.shell").Exec("cmd /c dir " & c00 & "*.xlsm /b/s").StdOut.ReadAll, vbCrLf)
  Set d = CreateObject("Scripting.Dictionary")
  For j = 0 To UBound(ar) - 1
    With GetObject(ar(j))
      ar2 = .Sheets(1).Range("A1:AB189").Value
      .Close 0
    End With
    For y = 1 To ar2(43, 18)
      d(d.Count + 1) = Array(ar2(y + 44, 4), ar2(y + 44, 8), ar2(y + 44, 15), ar2(y + 44, 27), ar2(y + 49, 8), ar2(105, 4 + y * 6), ar2(189, 4), ar2(173, 4 + y * 6))
    Next y
  Next j
  Sheet2.Cells(1).Resize(d.Count, 8) = Application.Index(d.items, 0, 0)
End Sub

Bedankt voor je tijd en moeite!
Ik krijg hiermee een foutmelding: 13 (typen komen niet met elkaar overeen)...?

tijmen_4real · 21 okt 2019

VenA zei:
Hoe staat het hiermee? https://www.helpmij.nl/forum/showthread.php/949398-Fout-91-tijdens-uitvoering-Objectvariabele-of-klokvariabele-With-is-niet-ingesteld

Plaats eens een voorbeeldbestand met wat wat waar staat en wat het resultaat moet worden.

Dit werkt prima, maar dit is een ander statusbestand wat data uit dezelfde documenten moet halen

VenA · 21 okt 2019

Verwijder eerst eens alle alle onnodige quotes.
Op welke regel krijg je de foutmelding? Heb je het pad wel aangepast?

Dit heb je blijkbaar gemist

Plaats eens een voorbeeldbestand met wat wat waar staat en wat het resultaat moet worden.

Als de code in het andere draadje prima werkt waarom meld je het daar dan niet en waarom zet je de vraag dan niet op opgelost?

tijmen_4real · 22 okt 2019

Code:

Sub MergeAllWorkbooks()
Dim j As Long, jj As Long, it, fl, ar, ar1, ar2

  c00 = "Ja, de locatie had ik hier aangepast"
  ar = Split(CreateObject("wscript.shell").Exec("cmd /c dir " & c00 & "*.xlsm /b/s").StdOut.ReadAll, vbCrLf)
  Set d = CreateObject("Scripting.Dictionary")
  For j = 0 To UBound(ar) - 1
    With GetObject(ar(j))
      ar2 = .Sheets(1).Range("A1:AB189").Value
      .Close 0
    End With
    For y = 1 To ar2(43, 18)
      d(d.Count + 1) = Array(ar2(y + 44, 4), ar2(y + 44, 8), ar2(y + 44, 15), ar2(y + 44, 27), ar2(y + 49, 8), ar2(105, 4 + y * 6), ar2(189, 4), ar2(173, 4 + y * 6))
    Next y
  Next j
  Sheet2.Cells(1).Resize(d.Count, 8) = Application.Index(d.items, 0, 0)
End Sub

Voorbeeld in bijlage.
Vorige topic als opgelost gemarkeerd.

Hoor graag van jullie!
Bedankt en groet,

Tijmen

tijmen_4real · 22 okt 2019

Foutmelding gebeurd na:

Code:

With GetObject(ar(j)).Sheets(1)

VenA · 22 okt 2019

't is allemaal wat. Het verwijderen van de onnodige quotes is nog niet echt gelukt.
Ik zou me ook eerst bezig houden met de beveiliging van een project dan kunnen de helpers er ook wat mee. Het enige wat zichtbaar is, is Blad1 maar hier staat behalve een header niets in.

Code:

With GetObject(ar(j)).Sheets(1)

Zie ik nergens in mijn code.

Lees deze link eerst maar eens door als je verder geholpen wilt worden: https://www.helpmij.nl/forum/announcement.php?f=5

tijmen_4real · 23 okt 2019

Goedemorgen,

Volgende poging: Voorbeeldbestanden in bijlage, zonder beveiliging.
(@VenA: je wilt de quotes uit het vorige topic weg hebben?)

Groet,

Tijmen

tijmen_4real · 28 okt 2019

Goedemorgen. Iemand die mij kan en wilt helpen?

snb · 28 okt 2019

Hij/zij stond al te trappelen: http://www.barnesandnoble.com/w/excel-vba-programming-for-dummies-john-walkenbach/1101874584

Excelbat · 28 okt 2019

https://www.excelforum.com/excel-programming-vba-macros/1294438-if-statement-for-with-loop.html

Crossposting.

Greetz/Excelbat

tijmen_4real · 28 okt 2019

Excelbat zei:
https://www.excelforum.com/excel-programming-vba-macros/1294438-if-statement-for-with-loop.html

Crossposting.

Greetz/Excelbat

Crossposting omdat ik het op een ander foru, op een andere website, in een andere taal ook vraag?
Is dat serieus niet toegestaan?

tijmen_4real · 28 okt 2019

snb zei:
Hij/zij stond al te trappelen: http://www.barnesandnoble.com/w/excel-vba-programming-for-dummies-john-walkenbach/1101874584

[sarcasme aan] Mooi boek, bedankt voor de tip! [sarcasme uit]
Ik begrijp dat dit zo vragen geen zin heeft.... Jammer, forum is dus voor vragen door mensen die alles al weten en dus eigenlijk geen vragen hebben...?

If-statement in With (loop)

tijmen_4real

Gebruiker

VenA

Inventaris

Haije

Terugkerende gebruiker

VenA

Inventaris

tijmen_4real

Gebruiker

tijmen_4real

Gebruiker

VenA

Inventaris

tijmen_4real

Gebruiker

Bijlagen

tijmen_4real

Gebruiker

VenA

Inventaris

tijmen_4real

Gebruiker

Bijlagen

tijmen_4real

Gebruiker

snb

Verenigingslid

Excelbat

Gebruiker

tijmen_4real

Gebruiker

tijmen_4real

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy