Foto's zoeken

[BART1988]

Werkt!

Alleen stelt zich het probleem nog, hoe de weggeschreven nummers kunnen gekopieerd worden.
In bijlage voorbeeld...

 

[cow18]

wat gebeurt er als je de kolombreedte nu eens verdrievoudigt en de rijhoogte reduceert ?
Komt dan alles netjes op 1 lijn te staan ?
Post anders eens een voorbeeldje.
Vermoedelijk wordt het iets als "Columns(1).autofit" of zoiets

 

[BART1988]

In bijlage de file, als je hieruit kopieert krijg je de voorbeelden uit #61.

Nu ik toch de file hier zet...
De laatste dingen die ikzelf aan het proberen was:

* Ik krijg zelf alleen de

kleur = IIf(.Interior.ColorIndex = 19, 20, 19)

toegevoegd in mijn " "_A.jpg"-bestanden", niet in die andere kolommen.

* Ik dacht simpel iets te kunnen toevoegen om ook .png te gaan zoeken, maar dit lijkt niet zo...

mijnfiles = Filter(Split(CreateObject("WScript.Shell").Exec("cmd /c dir " & mypath & "/b /s").StdOut.ReadAll, vbCr), "_A.jpg", 1, vbTextCompare)   'alle "_A.jpg"-bestanden in die subdrectories

 

[cow18]

AlleFiles zijn alle files in die subdirectory en onderliggend.
Daarvan maak je, door filteren, 2 afzonderlijke lijstjes, die jpg's en de png's.
Die voeg je opnieuw samen in "mijnfiles"

opnieuw niet getest.
Hopelijk gaat het niet fout als er geen "png-files" zijn

De rode regels vervangen die ene regel van "mijnfiles"

 mypath = Sheets("foto").Range("M1").Value     'in deze directory en onderliggende zoeken
   mijndir = Filter(Split(CreateObject("WScript.Shell").Exec("cmd /c dir /b /s /ad " & mypath).StdOut.ReadAll, vbCr), mypath, 1)   'alle subdirectories
  [COLOR="#FF0000"] allefiles = Split(CreateObject("WScript.Shell").Exec("cmd /c dir " & mypath & "/b /s").StdOut.ReadAll, vbCr)   'alle files in die subdirectorie en onderliggend
   jpg_files = Filter(allefiles, "_A.jpg", 1, vbTextCompare)   'alle "_A.jpg"-bestanden in die subdrectories
   png_files = Filter(allefiles, "_A.png", 1, vbTextCompare)   'alle "_A.png"-bestanden in die subdrectories
   mijnfiles = Split(Join(jpg_files, "|") & "|" & Join(png_files, "|"), "|")   ' de 2 samenvoegen[/COLOR]

Die kleur is die belangrijk ? Die was enkel voor demonstratieve doeleinden.
Anders kunnen we het ganse blad om en om inkleuren.

Op het zicht zijn de cijfers nu netjes op een lijn binnen de cel

 

[BART1988]

Kleur is niet belangrijk => Oké
.PNG werkt als er zijn, als er geen zijn geeft hij het aantal A_jpg bestanden + 1 =>Fout aantal dus...

& UBound(mijnfiles) + 1 & " _A.jpg-bestanden"

Dat zal hier mee te maken hebben, waarom staat er overal in MsgBox +1?

Kopiëren blijft hetzelfde probleem...

 

[cow18]

ik heb voor mezelf een testvoorbeeld gemaakt, omdat ik nooit zoveel fotos op mijn computer heb.
Dus in het begin van de macro, zie je daar voor "Bart", ik was vergeten dat jij ook een Bart bent, mijn criteria.
Er moet dus gezocht worden in de root "c:" naar alle xls, jpg, png en pdf's. (los van elkaar)
Daar is hij bij mij dik 3 minuten bezig voor 80.000 subdirectories en 500.000 files.

Op blad "kladversie" krijg je in de kolommen A en B die 80.000 en 500.000.
Daarna krijg je per filter (xls, jpg, png en pdf) 3 kolommen, een kolom subdirectories waar dat soort file wel en niet voor kwamen + de files zelf.
Bovenaan iedere kolom, in de 1e rij zou je een formule mogen schrijven in de vorm van =Foto!A3 (gewoon een =teken en dan ga je naar tabblad foto A3 en enter).
Op die manie zal op het einde van de macro gekeken worden of er in de 1e rij zoiets staat en zal de ganse kolom naar daar doorgekopieerd worden.
De 2 rij heeft uitleg wat er in die kolom staat en de aantallen.

Blijkbaar kan er tot 65.000 (vermoedelijk 65.536, 2 tot de 16e macht) elementen getransformeerd worden met als bijkomende voorwaarde dat een element niet langer mag worden dan 255 karakters.
Tot nogtoe had ik geen rekening gehouden met die 2e voorwaarde.

Aangezien na het draaien van die macro, het bestand 20 MB groot was, heb ik alles beperkt tot de 1e 20 rijen.

Straks maak je bovenin de macro wie="Bart2" en dan zou er moeten gedraaid worden volgens jouw voorwaarden.