• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

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)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse