Jump to content

form que lista subpastas e detalhes de uma pasta


Recommended Posts

Olá a todos!

Peço ajuda por favor porque sou um pouco nova nestas andanças

necessito de ajuda num codigo que devolva a lista de subpastas de uma pasta

mostrando os detalhes:

  • nome da pasta
  • num de ficheiros dentro da pasta
  • data de criação da pasta
  • data da ultima alteração á pasta

Muito obrigado a todos!

Prometo não ser muito chata! 😛

Link to comment
Share on other sites

Encontrei estes, vê se servem para o efeito pretendido.

Sub Ck()

   Dim strStartPath As String

   strStartPath = "C:\" 'ENTER YOUR START FOLDER HERE
   ListFolder strStartPath

End Sub
Sub ListFolder(sFolderPath As String)

   Dim FS As New FileSystemObject
   Dim FSfolder As Folder
   Dim subfolder As Folder
   Dim i As Integer

   Set FSfolder = FS.GetFolder(sFolderPath)

   For Each subfolder In FSfolder.SubFolders
    DoEvents
    i = i + 1
	 'added this line
    Cells(i, 1) = subfolder
	 'commented out this one
	 'Debug.Print subfolder
   Next subfolder

   Set FSfolder = Nothing

 'optional, I suppose MsgBox "Total sub folders in " & sFolderPath & " : " & i End Sub

Option Explicit

Sub TestListFolders()

   Application.ScreenUpdating = False

 'create a new workbook for the folder list

 'commented out by dr
 'Workbooks.Add

 'line added by dr to clear old data
   Cells.Delete

 ' add headers
   With Range("A1")
    .Formula = "Folder contents:"
    .Font.Bold = True
    .Font.Size = 12
   End With

   Range("A3").Formula = "Folder Path:"
   Range("B3").Formula = "Folder Name:"
   Range("C3").Formula = "Size:"
   Range("D3").Formula = "Subfolders:"
   Range("E3").Formula = "Files:"
   Range("F3").Formula = "Short Name:"
   Range("G3").Formula = "Short Path:"
   Range("A3:G3").Font.Bold = True

 'ENTER START FOLDER HERE
 ' and include subfolders (true/false)
   ListFolders "C:\", True

   Application.ScreenUpdating = True

End Sub

Sub ListFolders(SourceFolderName As String, IncludeSubfolders As Boolean)
 ' lists information about the folders in SourceFolder
 ' example: ListFolders "C:\", True
   Dim FSO As Scripting.FileSystemObject
   Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
   Dim r As Long

   Set FSO = New Scripting.FileSystemObject
   Set SourceFolder = FSO.GetFolder(SourceFolderName)

 'line added by dr for repeated "Permission Denied" errors

   On Error Resume Next

 ' display folder properties
   r = Range("A65536").End(xlUp).Row + 1
   Cells(r, 1).Formula = SourceFolder.Path
   Cells(r, 2).Formula = SourceFolder.Name
   Cells(r, 3).Formula = SourceFolder.Size
   Cells(r, 4).Formula = SourceFolder.SubFolders.Count
   Cells(r, 5).Formula = SourceFolder.Files.Count
   Cells(r, 6).Formula = SourceFolder.ShortName
   Cells(r, 7).Formula = SourceFolder.ShortPath
   If IncludeSubfolders Then
    For Each SubFolder In SourceFolder.SubFolders
	    ListFolders SubFolder.Path, True
    Next SubFolder
    Set SubFolder = Nothing
   End If

   Columns("A:G").AutoFit

   Set SourceFolder = Nothing
   Set FSO = Nothing

 'commented out by dr
 'ActiveWorkbook.Saved = True

End Sub

Podes lêr mais aqui:

http://www.erlandsendata.no/english/index.php?d=envbafolderslistfoldersscripting

http://www.vbforums.com/showthread.php?244880-VB-List-all-subfolders-in-a-specific-folder&s=

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.