Ir ao conteúdo
  • Cadastre-se
Deslexo

Outro VBA - Listar o autor quando listo uma árvore de arquivos

Recommended Posts

Bom dia!

 

Busquei aqui e em outros lugares, mas talvez por ignorância de não saber a 'pergunta correta' eu não estou localizando a solução.

Eu uso o código abaixo para listar uma árvore de arquivos e pastas, mas gostaria de listar também quem foi o autor do arquivo que ela listou.

Abaixo o código e anexo a planilha que utilizo, grifado em vermelho a parte que preciso criar, e a imagem da informação que estou tentando localizar.

 

Desde já agradeço qualquer ajuda!

 

--------------------------------------------------------------------------------------------------

Dim n As Long

Sub GerarÁrvoreCompleta()

       Sheets("Lista de arquivos").Select
       Range("A1").Select

    numRow = 7
    n = 7
    Do While ActiveSheet.Cells(numRow, 1).Value <> ""

        strCaminho = ActiveSheet.Cells(numRow, 1).Value

        Dim fso As Object 'Scripting.FileSystemObject
        Dim fld As Object 'Scripting.Folder

        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fld = fso.GetFolder(strCaminho)
    
' "CRIAR CABEÇALHO" - AUMENTAR O RANGE E INFORMAR O NOME DA COLUNA
       With ActiveSheet
          .Range("B6:E6") = Array("Caminho", "Nome", "Data Alteração", "Criado por")

           DescePasta fld
       End With

       numRow = numRow + 1
    Loop
    
' "COLAR VALOR" - AUMENTAR O RANGE QUANDO INCLUIR NOVAS COLUNAS
    Columns("E:E").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    
    Range("A1").Select
       
End Sub

Private Sub DescePasta(fld As Object) 'fld As Scripting.Folder

    Dim subfld As Object 'Scripting.Folder
    Dim fl As Object 'Scripting.File

    'Etapa 1 - Listar todos os arquivos desta Pasta.
    For Each fl In fld.Files
    
        'Obtem o caminho sem o nome
        strPath = Mid(fl.Path, 1, InStr(fl.Path, fl.Name) - 1)
        
       
        Cells(n, "B") = fl.Path
        Cells(n, "C") = fl.Name
        Cells(n, "D") = fl.DateLastModified
        Cells(n, "E") = fl.xxxxxxx

        n = n + 1
    Next fl
    
    'Etapa 2 - Recursar todas as subpastas desta pasta:
    For Each subfld In fld.SubFolders
        DescePasta subfld
    Next subfld

End Sub

 

------------------------------------------------------------------------------------------------

 

image.png.0a92326c0fc591dbd9c9cd369c071a4e.png

 

Modelo lista arvore de arquivos e pastas.zip

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×