Příspěvky uživatele


< návrat zpět

Vypísanie cesty všetkých súborov (1.3.2021 10:59)

jo jo stačí připsat aby se při každým spuštění nejdřív vše smazalo, a hledání prázdného řádku dát do cyklu

Sub PrintFolders()
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("A2").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

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)
Sheets("Hárok2").Cells(radek, 3) = RozdelNazev(Fl.Path, 5)
Sheets("Hárok2").Cells(radek, 4) = GetProperties(Fl.Path, 190)
Sheets("Hárok2").Cells(radek, 5) = GetProperties(Fl.Path, 164)
Sheets("Hárok2").Cells(radek, 6) = GetProperties(Fl.Path, 1)



Next

Set fsObj = Nothing
Set FD = Nothing
Set Fs = Nothing
End Sub


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