Sviluppare funzionalita su Microsoft Office con VBA Excel VBA – Elenco file di una cartella elencando separatam. anche le sottocart.

LoginRegistrati
Stai vedendo 1 articolo (di 1 totali)
  • Autore
    Articoli
  • #23381 Risposta

    Diego Cabras

      Salve, ho la necessità di creare il classico elenco di file contenuti in una cartella principale ma elencando separatamente, per ogni file, le sottocartelle nel quale è allocato, in modo da poter aggregare i dati con una tabella pivot.

       

      Al momento riesco con un codice che ho trovato ad ottenere il seguente risultato :

      Es.  c:\cartella1\cartella 1.1\cartella 1.1.1\file.ext  

      c:\cartella1\cartella 1.1\cartella 1.1.1  |  file.ext   |  estensione file  |  dimensione file  |  data creazione  |  ultima modifica  |  link folder  |  link file

      Invece a me servirebbe ottenere questo tipo di split delle cartelle, cercando di automatizzare lo slittamento delle colonne in base alla quantità di sottocartelle :

       c:\cartella1  |  cartella 1.1  |  cartella 1.1.1  |   file.ext  |  estensione file  |  dimensione file  |  data creazione  |  ultima modifica  |  link folder  |  link file
       

      questo è il codice che sto utilizzando:

       

      Dim ActualFilesCount As Long
      Dim TotalFilesCount As Long
      Dim TotalFoldersCount As Long
      Const FirstRow As Integer = 4
      Dim StopCode As Integer

      Sub CommandButton1_Click()

      Dim FileSystem As Object
      Dim HostFolder As String

      If StopCode = 0 Then
         
          StopCode = 1
         
          CommandButton1.Caption = "Cancel"
         
          Call Clear
         
          HostFolder = GetFolder
         
          If HostFolder = "" Then GoTo Finish
         
          Cells(2, 1).Value = "Preparing, please wait..."
         
          Call FilesFoldersCounts(HostFolder)
         
          Cells(2, 1).Value = TotalFilesCount & " files and " & TotalFoldersCount & " folders found in " & HostFolder
         
          Application.ScreenUpdating = False
         
          Set FileSystem = CreateObject("Scripting.FileSystemObject")
         
          DoFolder FileSystem.GetFolder(HostFolder), FirstRow - 1
         
          Set FileSystem = Nothing
         
          Range(Cells(FirstRow - 1, 1), Cells(TotalFilesCount + FirstRow - 1, 6)).AutoFilter
          Range(Cells(FirstRow, 1), Cells(TotalFilesCount + FirstRow - 1, 8)).WrapText = True
          Range(Cells(FirstRow, 1), Cells(TotalFilesCount + FirstRow - 1, 8)).VerticalAlignment = xlCenter
          Range(Cells(FirstRow, 1), Cells(TotalFilesCount + FirstRow - 1, 8)).Rows.AutoFit
          Range(Cells(FirstRow, 7), Cells(TotalFilesCount + FirstRow - 1, 8)).HorizontalAlignment = xlCenter
         
          Range("A5").Select
         
      Finish:
          Application.ScreenUpdating = True
          If HostFolder = "" Then Cells(2, 1).Value = ""
          'ProgressBar1.Value = 0
          ActiveSheet.Protect AllowFiltering:=True
          Range("A5").Select
          StopCode = 0
          CommandButton1.Caption = "Select Folder to List Files"

      ElseIf StopCode = 1 Then
         
          Call Clear
         
          ActiveSheet.Protect AllowFiltering:=True
         
          StopCode = 0
         
          CommandButton1.Caption = "Select Folder to List Files"
         
          End

      End If

      End Sub

      Sub DoFolder(Folder, j As Long)

      If ExecuteCode = True Then Exit Sub

      Dim SubFolder, File
           

      For Each SubFolder In Folder.subFolders
         
          DoFolder SubFolder, j
               
          DoEvents

      Next

      For Each File In Folder.Files
         
          j = j + 1
         
          Cells(j, 1).Value = Folder      'Cells(j, 1).Value = File.Path
          Cells(j, 2).Value = File.Name
          Cells(j, 3).Value = GetFileExt(File.Name)
          Cells(j, 4).Value = File.Size
          Cells(j, 5).Value = File.DateCreated
          Cells(j, 6).Value = File.DateLastModified
          Cells(j, 7).Formula = "=HYPERLINK(RC[-6],""Open Folder"")"
          Cells(j, 8).Formula = "=HYPERLINK(RC[-7]&""\""& RC[-6],""Open File"")"

      Next

      ActualFilesCount = j - (FirstRow - 1)

      'ProgressBar1.Min = 0
      'ProgressBar1.Max = 100
      'ProgressBar1.Value = Int(ActualFilesCount / TotalFilesCount * 100)

      End Sub

      Function GetFolder() As String

      Dim fldr As FileDialog
      Dim sItem, InitialPath As String
      Dim UserSelection As Boolean

      Set fldr = Application.FileDialog(msoFileDialogFolderPicker)

      With fldr
          InitialPath = .InitialFileName
          .Title = "Select a Folder"
          .AllowMultiSelect = False
          '.InitialFileName = "C:\"
         
           If .Show = -1 Then
              sItem = .SelectedItems(1)
             Else
          End If

      GoTo NextCode

      End With

      NextCode:
      GetFolder = sItem
      Set fldr = Nothing

      End Function

      Function GetFileExt(FileName) As String

      If InStr(FileName, ".") <> 0 Then
          GetFileExt = Right(FileName, Len(FileName) - InStrRev(FileName, "."))
      Else
          GetFileExt = ""
      End If

      End Function

      Sub FilesFoldersCounts(localRoot, Optional fld, Optional count As Long, Optional k As Long)

      Dim fso, f, baseFolder, SubFolder
         
         
      Set fso = CreateObject("Scripting.Filesystemobject")

      If IsMissing(fld) Then
          Set baseFolder = fso.GetFolder(localRoot)
      Else
          Set baseFolder = fld
      End If

      count = count + baseFolder.Files.count
      k = k + baseFolder.subFolders.count
         
      For Each SubFolder In baseFolder.subFolders
             
          FilesFoldersCounts localRoot, SubFolder, count, k
         
      Next

        
      TotalFilesCount = count
      TotalFoldersCount = k

      Set fso = Nothing
      Set baseFolder = Nothing

      End Sub

      Sub Clear()
      ActiveSheet.Unprotect
      Cells(2, 1).Value = ""
      Range(Cells(FirstRow, 1), Cells(1048576, 8)).Clear
      'ProgressBar2.Value = 0
      ActiveSheet.AutoFilterMode = False
      End Sub

       

      Ringrazio anticipatamente per qualsiasi aiuto/suggerimento.

       

      Diego.

    LoginRegistrati
    Stai vedendo 1 articolo (di 1 totali)
    Rispondi a: Excel VBA – Elenco file di una cartella elencando separatam. anche le sottocart.
    Gli allegati sono permessi solo ad utenti REGISTRATI
    Le tue informazioni:



    vecchio frac - 2750 risposte

    albatros54
    albatros54 - 833 risposte

    patel
    patel - 724 risposte

    Marius44
    Marius44 - 634 risposte

    Luca73
    Luca73 - 587 risposte