• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

VB code voor automatisch opslaan bestanden als map

Status
Niet open voor verdere reacties.
B

Boerlo

Gebruiker
Lid geworden
14 jan 2021
Berichten
40
Ik heb dankzij hulp op dit forum onderstaande code gemaakt voor het automatisch opslaan van CSV-bestanden. De code kijkt in een bepaalde map en slaat daarvan alle bestanden op als tabblad in het Excel-bestand, behalve degene die er al in staan. Vervolgens vervangt hij in alle mappen de punten door komma's.

Nu staan er véél bestanden in de map en véél tabbladen in het Excel-bestand, dus de code duurt erg lang, omdat hij die hele rits gaat controleren. Hoe kan ik deze code sneller maken?

Kan ik de code aanpassen zodat hij alleen aanvult vanaf het laatste tabblad?
Kan ik de code zo aanpassen zodat hij alleen de punten in komma's verandert van het zojuist opgeslagen tabblad?

Code: 
Sub Logbestanden()

Windows("Logbestanden.xlsx").Activate
  c00 = "D:\Gebruikers\Boerlo\Documenten\Data\"
  For Each sh In Sheets
    c01 = c01 & sh.Name
  Next sh
  For Each it In Split(CreateObject("Wscript.Shell").Exec("cmd /c dir """ & c00 & "*.csv"" /b").StdOut.ReadAll, vbCrLf)
    If it = "" Then GoTo Verder
    If InStr(c01, Split(it, ".")(0)) = 0 Then
      With GetObject(c00 & it)
        .Sheets(1).Copy , After:=Workbooks("Logbestanden.xlsx").Sheets(Workbooks("Logbestanden.xlsx").Sheets.Count)
        .Close 0
      End With
    End If
  Next it

'Punt_naar_komma
For Each ws In Workbooks("Logbestanden.xlsx").Sheets
 ws.UsedRange.Replace What:=".", Replacement:=","
Next ws

End Sub
 
Code: 
Sub Logbestanden()

     Set Wb = Workbooks("Logbestanden.xlsm")                    'jouw werkboek
     Wb.Activate
     c00 = "D:\Gebruikers\Boerlo\Documenten\Data\"              'jouw subdirectory
     'c00 = ThisWorkbook.Path & "\"                              'mijn subdirectory

     For Each sh In Sheets
          c01 = c01 & "|" & sh.Name                             ' "|" als separator
     Next sh
     sp = Split(Mid(c01, 2), "|")                               'alle namen splitsen

     For Each it In Split(CreateObject("Wscript.Shell").Exec("cmd /c dir """ & c00 & "*.csv"" /b").StdOut.ReadAll, vbCrLf)
          If it = "" Then Exit Sub                              'GoTo Verder                           'waar is verder ???
          If UBound(Filter(sp, Split(it, ".")(0), 1, vbTextCompare)) = -1 Then     'bestaat werkblad nog niet ?l
               With GetObject(c00 & it)
                    .Sheets(1).Copy , After:=Wb.Sheets(Wb.Sheets.Count)
                    .Close 0
               End With
               ActiveSheet.UsedRange.Replace What:=".", Replacement:=","     'zonet binnengehaald blad vervangen . -> ,
          End If
     Next it
End Sub
 
RE: VBA code voor automatisch opslaan bestanden als map

Cow18, hartelijk dank, dit werkt. Vraag opgelost.

Wel twee vragen nog uit interesse om hiervan te leren:


Ten eerste krijg ik problemen met dit stuk:
Code: 
     Set Wb = Workbooks("Logbestanden.xlsm")                    'jouw werkboek
     Wb.Activate
Dat komt waarschijnlijk omdat deze code in een ander werkboek staat. Dat werkboek opent werkboek "logbestanden.xlsm", werkt dat bij en haalt daar dan de informatie uit.
Als ik dat weer aanpas naar het volgende, werkt het wel:
Code: 
Windows("Logbestanden.xlsx").Activate
Heeft het consequenties als ik niet met "Set Wb" werk?


Ten tweede ben ik benieuwd naar de betekenis hiervan in jouw code:
Code: 
     For Each sh In Sheets
          c01 = c01 & "|" & sh.Name                             ' "|" als separator
     Next sh
     sp = Split(Mid(c01, 2), "|")                               'alle namen splitsen

Wat is de functie van die separator?

Werkt jouw code anders dan de mijne? M.a.w. gaat jouw code niet door ALLE bestanden heen, maar voegt hij enkel de laatste toe?

Hartelijk dank!
 
Je macro staat dus in een andere file dan "logbestanden.xlsx", misschien zelfs in een algemene zoals "personlk.xlsm".
Dan is je insteek goed, de mijne fout.
Maar Select en Activate zijn zo een beetje een vloek voor de wat gevorderde VBA-ers, omdat dat te veel tijd neemt, wat hier misschien geen beletsel zou kunnen zijn.
Daarom doe ik toch die set WB=workbooks("logbes...") en gebruik ik verder in de code die WB als voorvoegsel aan de rest.
Op die manier zit je als het ware te rommelen in die werkmap zonder dat je er in staat.
Je moet er wel je hoofd bij houden !


Code: 
Sub Logbestanden()

     [COLOR="#FF0000"]Set wb [/COLOR]= Workbooks("Logbestanden.xlsx")                    'verwijzing naar jouw werkboek, zonder er echt in te staan

     c00 = "D:\Gebruikers\Boerlo\Documenten\Data\"              'jouw subdirectory
     ' c00 = ThisWorkbook.Path & "\"                              'mijn subdirectory

     For Each sh In [COLOR="#FF0000"]wb[/COLOR].Sheets
          c01 = c01 & "|" & sh.Name                             'alle werkbladen van logbestanden.xlsx  "|" als separator in 1 tekststring
     Next sh
     sp = Split(Mid(c01, 2), "|")                               'alle namen splitsen op die separator om er een array van te maken
     MsgBox Join(sp, vbLf)                                      'enkel voor de grap, ze weer samenvoegen met een linefeed (vblf) om ze in een msgbox te tonen

     myfiles = Split(CreateObject("Wscript.Shell").Exec("cmd /c dir """ & c00 & "*.csv"" /b").StdOut.ReadAll, vbCrLf)     'array van alle csv-bestanden in je subdirectory
     MsgBox Join(myfiles, vbLf)                                 'enkel voor de grap, ze weer samenvoegen met een linefeed (vblf) om ze in een msgbox te tonen

     For i = 0 To UBound(myfiles)
          If myfiles(i) = "" Then Exit Sub                      'GoTo Verder                           'waar is verder ???
          If UBound(Filter(sp, Split(myfiles(i), ".")(0), 1, vbTextCompare)) = -1 Then     'bestaat werkblad nog niet ?l
               MsgBox "volgende file : " & vbLf & c00 & myfiles(i)
               With GetObject(c00 & myfiles(i))
                    .Sheets(1).Copy , After:=[COLOR="#FF0000"]wb[/COLOR].Sheets([COLOR="#FF0000"]wb[/COLOR].Sheets.Count)
                    .Close 0
               End With
               [COLOR="#FF0000"]wb[/COLOR].Sheets([COLOR="#FF0000"]wb[/COLOR].Sheets.Count).UsedRange.Replace What:=".", Replacement:=","     'zonet binnengehaald blad vervangen . -> ,
          End If
     Next
End Sub
 
die split, die knipt een tekststring netjes in stukjes op de "separator".
Voor je werkbladen gebruikte ik daarvoor "|".
Het is dus gemakkelijk eerst al je werkbladen in een string samen te voegen en ze daarna te splitsen, want je weet vooraf niet hoeveel je er zal hebben.

Het vergelijken later in je code wordt ook een stuk gemakkelijker.
stel je hebt een nieuw aan te maken werkblad "blad1" en er bestond al een werkblad "blad11".
Met je instr-regel zou dat een match opleveren en zou je dat werkblad overslaan.
Met die filter ga je een exacte overeenkomst checken (het had ook nog anders gekund met een application.match)
Maar misschien nog gemakkelijker, dan had je dat loopje door je al aanwezige werkbladen niet moeten maken is gewoon checken of dat werkblad al bestaat.
Voor je gemak staat die nu ook nog een keer als formule in je huidig werkblad cel A1
....
Code: 
 If InStr(c01, Split(it, ".")(0)) = 0 Then
If UBound(Filter(sp, Split(myfiles(i), ".")(0), 1, vbTextCompare)) = -1 Then
 [COLOR="#FF0000"]If Evaluate("ISREF('[" & wb.Name & "]" & Split(myfiles(i), ".")(0) & "'!$A$1)") = False Then[/COLOR]

nieuwere versie

Code: 
Sub Logbestanden()

     Set wb = Workbooks("Logbestanden.xlsx")                    'verwijzing naar jouw werkboek, zonder er echt in te staan

     c00 = "D:\Gebruikers\Boerlo\Documenten\Data\"              'jouw subdirectory
     'c00 = ThisWorkbook.Path & "\"                              'mijn subdirectory

     myfiles = Split(CreateObject("Wscript.Shell").Exec("cmd /c dir """ & c00 & "*.csv"" /b").StdOut.ReadAll, vbCrLf)     'array van alle csv-bestanden in je subdirectory
     MsgBox UBound(myfiles) + 1 & " files !!!!!!!!" & vbLf & Join(myfiles, vbLf)     'enkel voor de grap, ze weer samenvoegen met een linefeed (vblf) om ze in een msgbox te tonen, mag straks weg

     For i = 0 To UBound(myfiles)                               'opgelet !!! begint altijd bij 0
          If myfiles(i) = "" Then Exit Sub                      'GoTo Verder                           'waar is verder ???
          ActiveSheet.Range("A1").Value = "'=ISREF('[" & wb.Name & "]" & Split(myfiles(i), ".")(0) & "'!$A$1)"     'voor de grap, om je te tonen hoe je checkt of een werkblad bestaat in A1
        [COLOR="#FF0000"]  If IsError(Evaluate("ISREF('[" & wb.Name & "]" & Split(myfiles(i), ".")(0) & "'!$A$1)")) Then[/COLOR]
               MsgBox "volgende file : " & vbLf & c00 & myfiles(i)     'vervelende boodschap
               With GetObject(c00 & myfiles(i))
                    .Sheets(1).Copy , After:=wb.Sheets(wb.Sheets.Count)
                    .Close 0
               End With
               wb.Sheets(wb.Sheets.Count).UsedRange.Replace What:=".", Replacement:=","     'zonet binnengehaald blad vervangen . -> ,
          Else
               MsgBox myfiles(i) & " bestond al als werkblad", vbInformation     'vervelende boodschap
          End If
     Next
End Sub
 
Laatst bewerkt:
nog een nieuwere versie toegevoegd in vorige post
 
Interessant, bedankt. Ja ik gebruik nu de nieuwere versie. Heel mooi met die tussenstapjes via MsgBox, dan leer ik beter begrijpen wat er stapsgewijs gebeurt. Dank!

NB, je vroeg waar "verder" (GoTo Verder) was, die is inderdaad verdwenen, die stond aanvankelijk onderaan boven het stukje "Punt naar Komma" maar die is nu vervallen omdat je dit stuk al bovenin hebt gezet. Exit Sub is dus prima.

Nog 1 vraag:
Nu worden alle tabbladen gecheckt en vergeleken met de files in de map. Als er een file wordt aangetroffen die nog niet voorkomt als tabblad, wordt dat aangemaakt als tabblad.
Is het mogelijk om niet telkens ALLE tabbladen en ALLE bestanden te checken (want dat kunnen er in theorie uiteindelijk honderden zijn), maar alléén te kijken naar de LAATSTE? De files hebben de volgende format "21-11-29" (= 29-nov-2021), "21-11-28", "21-11-27" etc. etc. Stel nu dat we vandaag (29-11) alles bijgewerkt hebben en pas dan weer op 5 december (21-12-05) gaan bijwerken. Dan moet hij dus ZES files toevoegen, nl. 30-nov t/m 05-dec. Zou de code sneller werken als hij dan alleen naar de jongste datum kijkt (in dit geval 29-nov) in plaats van dat hij ALLE tabbladen gaat checken en met ALLE bestanden gaat vergelijken? In andere woorden: de code zou dan moeten zien dat 29-nov (= file/tabblad 21-11-29) de jongste file is, weet dat het vandaag 05-dec is, en zal dan enkel die 6 files toevoegen, zonder alles vóór 29-11 te gaan checken. De tweede versie zou misschien sneller werken als er sprake is van honderden files.
 
Laatst bewerkt:
dan zijn we terug naar af, zoveel mogelijk in het geheugen werken, zo weinig mogelijk interactie met werkbladen
er wordt een chronometer bijgehouden, dus alle msgboxes zijn weg, want die vervalsen het beeld.
Je vorige datum staat gewoon als datum in blad1 cel A2 of je moet het de macro op een andere manier duidelijk maken

De eerste keer ik de macro draaide, zonder die "Doevents" werd de macro gestopt door het systeem wegens "mogelijks schadelijke macro" !
Krijg je die per ongeluk ook ?

Code: 
Sub Logbestanden()

     t0 = Timer                                                 'chrono starten

     vorige_datum = Format(ThisWorkbook.Sheets("blad1").Range("A2"), "yy-mm-dd")     'in A2 staat je vorige datum of op een andere manier vastleggen !!!!

     Set wb = Workbooks("Logbestanden.xlsx")                    'verwijzing naar jouw werkboek, zonder er echt in te staan

     c00 = "D:\Gebruikers\Boerlo\Documenten\Data\"              'jouw subdirectory
     'c00 = ThisWorkbook.Path & "\"                              'mijn subdirectory

     For Each sh In wb.Sheets                                   'in verband met snelheid toch deze methode
          c01 = c01 & "|" & sh.Name                             'alle werkbladen van logbestanden.xlsx  "|" als separator in 1 tekststring
     Next sh
     sp = Split(Mid(c01, 2), "|")                               'alle namen splitsen op die separator om er een array van te maken
     DoEvents
     t1 = Timer                                                 '1e tussentijd

     myfiles = Split(CreateObject("Wscript.Shell").Exec("cmd /c dir """ & c00 & "*.csv"" /b").StdOut.ReadAll, vbCrLf)     'array van alle csv-bestanden in je subdirectory
     DoEvents
     t2 = Timer                                                 '2e tussentijd

     For i = 0 To UBound(myfiles)                               'opgelet !!! begint altijd bij 0
          If Len(myfiles(i)) > 0 Then 'laatste knipsel is niets
               naam = Split(myfiles(i), ".")(0) 'deel van de filenaam voor het eerste punt
               datum = Right(naam, 8)                           'de laatste 8 karakters zijn mogelijks een datum
               If datum Like "##-##-##" Then                    'lijken de laatste 8 karakters op een datum van dat type lijkt
                    If StrComp(datum, vorige_datum, vbTextCompare) [COLOR="#FF0000"][SIZE=5]>= 0[/SIZE][/COLOR] Then     'is die datum groter (1) of gelijk (0) aan je referentiedatum
                         If UBound(Filter(sp, naam, 1, vbTextCompare)) = -1 Then     'bestaat werkblad nog niet ? veel sneller dan die evaluate
                              With GetObject(c00 & myfiles(i))
                                   .Sheets(1).Copy , After:=wb.Sheets(wb.Sheets.Count)
                                   .Close 0
                              End With
                              wb.Sheets(wb.Sheets.Count).UsedRange.Replace What:=".", Replacement:=","     'zonet binnengehaald blad vervangen . -> ,
                         End If
                    End If
               End If
          End If
     Next
     DoEvents
     t3 = Timer                                                 '3e tussentijd

     MsgBox "klaar in : " & Format(t3 - t0, "0.0") & " sec" & vbLf & vbLf & "je werklbaden langslopen : " & Format(t1 - t0, "0.0") & " sec" & vbLf & "lijst van je csv : " & Format(t2 - t1, "0.0") & " sec" & vbLf & "toevoegen werkbladen : " & Format(t3 - t2, "0.0") & " sec"
End Sub
nu zou je voor de grap die >=0 kunnen vervangen door >=-1, dat wil zeggen dat hij eigenlijk ook alle vroegere versies van je CSV-files ook moet langslopen, dat tijdsverschil tusen de 2 versies, dan heb je waarschijnlijk niet eens de tijd gehad om met je ogen te knipperen
 
Laatst bewerkt:
Schitterend. Heel leerzaam. Ik ga ze beiden proberen. Super dank.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan