< návrat zpět

MS Excel

Téma: hladanie súboru v priecinkoch rss

Zaslal/a Sperhak 12.7.2021 13:00

Zdravím. Kód mi robí to že nájde súbor v priečinkoch, avšak ide iba do 2 podpriečinkov ak je ich viac vypíše chybu. Vedeli by ste mi pomôct? Ako mám spraviť to aby súbor našlo aj ked bude podpriečinkov povedzme 10. Vedel by som tam pridať 10x for each ale čo ak bude podpriečinkov 11 chcel by som to mať nejak automacické snád chápete ako to myslím.Sub PrintFolders() 'testovaci
Dim objFSO As Object
Dim objFolder As Object
Dim kategorie As Object
Dim film As Object
Dim folder As String

Sheets("Hárok2").Range("A2:F" & Sheets("Hárok2").Range("A99999").End(xlUp).Row).ClearContents
Application.StatusBar = ""
folder = Sheets("Hárok1").Range("B2").Value & ":\"

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(folder)
i = 1
'On Error GoTo handleCancel
Application.EnableCancelKey = xlErrorHandler

For Each kategorie In objFolder.subfolders

For Each film In kategorie.subfolders

Call PrintFiles(film.Path)

Next film
Next kategorie
handleCancel:
If Err = 18 Then
MsgBox "You cancelled"
End If
End Sub

Zaslat odpověď >
Strana:  1 2   další »
elninoslov(12.7.2021 17:37)#050982
elninoslov
Na to treba rekurzívnu metódu, nie vnáranie cyklov. Už som sem také niečo dával X krát. Ale skôr ako to nájdem, to znovu napíšem. No upresnite to, nech to nerobím zbytočne. Ten Váš kód práve postráda to hľadanie o ktorom píšete. Jedine, že by niečo porovnávala tá metóda "PrintFiles". Čo má byť účelom? Máte nejakú časť názvu, a chcete vypísať cestu k súboru, ktorého názov obsahuje daný text, či čo? Alebo chcete vypísať celú adresárovú štruktúru? To potom nieje hľadanie súboru.
...citovat
Sperhak(12.7.2021 17:44)#050983
avatar
Skúsim to vysvetliť asi som spravil chybu že som dal len časť kódu, myslel som že to bude stačiť. Ak je cesta H:\Filmy\Robocop\Robocop.mkv
funguje to.
Ak je cesta dlhšia o jeden alebo viac podpriečinkov napr.
H:\Filmy\Robocop\novy\Robocop.mkv
tak to už nefunguje.
S tým "PrintFiles" sa dalej pracuje ale tam podla mna problém nieje ale tu je celý kód.
Má to nájsť všetky filmy na disku a vytvoriť zoznam s podrobnostami cestami velkostami atd.
Sub PrintFolders() 'testovaci
Dim objFSO As Object
Dim objFolder As Object
Dim kategorie As Object
Dim film As Object
Dim folder As String

Sheets("Hárok2").Range("A2:F" & Sheets("Hárok2").Range("A99999").End(xlUp).Row).ClearContents
Application.StatusBar = ""
folder = Sheets("Hárok1").Range("B2").Value & ":\"

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(folder)
i = 1
'On Error GoTo handleCancel
Application.EnableCancelKey = xlErrorHandler

For Each kategorie In objFolder.subfolders

For Each film In kategorie.subfolders

Call PrintFiles(film.Path)
Call ShowVolumeInfo

Next film
Next kategorie
handleCancel:
If Err = 18 Then
MsgBox "You cancelled"
End If
End Sub

Sub PrintFiles(ByVal FolderName As String)
Dim fsObj, FD, fs, Fl As Object
Dim FullPath, nameoffile As String
Dim Velikost As Long
Dim radek As Long

radI = 2

Set fsObj = CreateObject("Scripting.FileSystemObject")
Set FD = fsObj.GetFolder(FolderName)
Set fs = FD.Files

For Each Fl In fs
radek = Sheets("Hárok2").Range("A99999").End(xlUp).Row + 1
nameoffile = Fl.Name

Sheets("Hárok2").Cells(radek, 1) = Fl.Path
Sheets("Hárok2").Cells(radek, 2) = GetProperties(Fl.Path, 0) 'nazov
Sheets("Hárok2").Cells(radek, 3) = GetProperties(Fl.Path, 190) 'priecinok v ktorom je subor
Sheets("Hárok2").Cells(radek, 4) = GetProperties(Fl.Path, 164) 'pripona
Sheets("Hárok2").Cells(radek, 5) = GetProperties(Fl.Path, 1) 'velkost
Sheets("Hárok2").Cells(radek, 6) = GetProperties(Fl.Path, 27) 'trvanie

Next

Set fsObj = Nothing
Set FD = Nothing
Set fs = Nothing
End Sub
Sub ShowVolumeInfo() 'ziska nazov disku
Dim fs, d, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(Range("A2").Value)))
s = d.VolumeName
Range("G2") = s
End Sub
citovat
icon eLCHa(13.7.2021 9:48)#050984
eLCHa
Můžete použít PowerShellSub subFind()
Dim sPath As String
sPath = "H:\Filmy\"

Dim sFile As String
sFile = "Robocop.mkv"

Dim sCommand As String
sCommand = "PowerShell ""Get-Childitem –Path " & sPath & " -Include *" & sFile & "* -Recurse -File -ErrorAction SilentlyContinue | Select FullName -ExpandProperty FullName"""

Dim oShell As Object
Set oShell = CreateObject("WScript.Shell")

Dim sRerurn As String
sRerurn = oShell.Exec(sCommand).StdOut.ReadAll

Set oShell = Nothing

MsgBox sRerurn
End Subcitovat
Dingo(13.7.2021 10:25)#050985
avatar
Už jsem tu před lety dával soubor, který by v tomto případě mohl posloužit, buď úplně nebo jako vzor řešení. Kdysi jsem ho potkal někde na internetu, ale zdroj už přesně neznám.
edit: vinou haprujícího připojení se mi nedaří připojit soubor, ale dá se na Wall.cz vyhledat: hledejte VypisAdresareSoubory_4.zip
nebo by to mělo být v https://wall.cz/index.php?m=topic&id=17836&page=1#post-39166citovat
Sperhak(13.7.2021 17:29)#050987
avatar
Ten súbor som našiel a snažil som sa to upraviť no je to namna moc zložité a nepodarilo sa mi to.citovat
Dingo(13.7.2021 17:50)#050988
avatar
Tak to je zlé, doufejte v pomoc od elninoslov, ten je tu nejšikovnější.citovat
Sperhak(13.7.2021 19:42)#050989
avatar
No este pockam ak sa nik nepodujme tak tam skusim toto dat aspon 6x a to by mi malo stacit.

For Each kategorie In objFolder.subfolders
For Each film In kategorie.subfolderscitovat
elninoslov(13.7.2021 21:22)#050990
elninoslov
No elninoslov má funkčný základ napísaný, akurát mám pracovné veci. Momentálne píšem z auta...

EDIT 13.7.2021 22:36:
Už som konečne doma. Tu máte rýchlo beta verziu...
V najbližších dňoch, no neviem neviem, asi nepomôžem, uvidím ako sa mi to tu bude vyvíjať ...

Uvažoval som aj nad možnosťou to urobiť tak, že sa urobí najskôr zoznam súborov, aby sa vedelo koľko ich je, a potom by sa začali načítavať info. Kvôli zobrazeniu ProgressBaru. Na to som zatiaľ pre nedostatok času zanevrel.
Příloha: zip50990_vypis-info-o-filmoch-beta-verzia.zip (28kB, staženo 14x)
citovat
Sperhak(13.7.2021 22:57)#050991
avatar
Vdaka s progress barom sa netráp to nepotrebujem. Len mi to nefunguje ak napíšem H:\ ,musím začat s priečinkom napr. H:\Filmy budem si nad tým lámať hlavu kým mi to nespravíš ty :D alebo sa mi to zázrakom podarí, pretože si ten script celý prerobil a strácam sa tam :Dcitovat
Sperhak(13.7.2021 23:12)#050992
avatar
A teraz som vlastne zistil že tam nemôže byť to mazanie toho zoznamu čo je hned na začiatku. Tie dáta chcem použit ako databázu a dalej s nimi pracovať a priradovat k nim veci.
Teraz som zistil že ak to zmažem a znova načítam tak mi tie veci čo som knim priradil náhodne priradí k iným filmom. Dúfam že ma chápete.

Edit: tak som zistil že ten tvoj bude dobrý lebo stačilo odstrániť to mazanie a ked ho opakovane spúštam tak tam nerobí duplicity ako ten čo som mal predtým. Takže to je ok.citovat

Strana:  1 2   další »

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje