Liste arquivos em uma pasta usando VBA no Microsoft Excel

Anonim

Neste artigo, criaremos uma macro para listar todos os arquivos da pasta.

Ao executar a macro, o nome do arquivo junto com o caminho do arquivo serão exibidos a partir da célula A17.

Explicação lógica

Neste artigo, criamos duas macros, “subfolder_files” e “getting_filelist_in_folder”.
A macro “subfolder_files” pega o caminho da pasta e o valor booleano como entradas e retorna o nome do arquivo dentro da pasta.

“Getting_filelist_in_folder” é usado para chamar a macro “subfolder_files”. Ele fornece o valor do caminho da pasta para a macro, com o valor booleano definido como 'verdadeiro'. Além disso, quando os nomes dos arquivos nas subpastas são necessários, atribuímos o valor booleano 'true'.

Explicação do código

folder_path = Sheet1.TextBox1.Value
O código acima é usado para extrair o valor da string da caixa de texto.

Chame subfolder_files (folder_path, True)
O código acima é usado para chamar a macro “subfolder_files”. Ele atribui o caminho da pasta e define a propriedade “include_subfolder” como true.

Defina fso = CreateObject ("scripting.filesystemobject")
O código acima é usado para criar o objeto do sistema de arquivos.

Set subfolder1 = fso.getfolder (folder_path)
O código acima é usado para criar o objeto da pasta definida.

Para Cada pasta1 Em subpasta1.subpastas
Chamar subfolder_files (folder1, True)
Próximo
O código acima é usado para examinar todas as subpastas, dentro da pasta principal.

Dir (folderpath1 & "* .xlsx")
O código acima é usado para obter o nome do arquivo do Excel.

Enquanto o nome do arquivo ""
contagem1 = contagem1 + 1
ReDim Preserve filearray (1 para contar1)
filearray (contagem1) = nome do arquivo
nome do arquivo = Dir ()
Wend

O código acima é usado para criar um array, que consiste em todos os nomes de arquivo presentes na pasta.

Para i = 1 para UBound (filearray)
Células (lastrow, 1) .Value = folderpath1 & filearray (i)
lastrow = lastrow + 1
Próximo

O código acima é usado para atribuir o nome do arquivo dentro da matriz à pasta de trabalho.

Siga abaixo para o código

 Option Explicit Sub subfolder_files (folderpath1 As Variant, Optional include_subfolder As Boolean) 'Verificando se inclui a subpasta ou não If include_subfolder Then' Declarando variáveis ​​Dim filename, filearray () As String Dim lastrow, count1, i As Integer 'Verificando se o caminho da pasta contém barra invertida como último caractere If Right (folderpath1, 1) "\" Then folderpath1 = folderpath1 & "\" End If 'Obtendo o nome do primeiro arquivo no caminho de pasta definido filename = Dir (folderpath1 & "* .xlsx")' Obtendo o número da linha da última célula lastrow = ActiveCell.SpecialCells (xlCellTypeLastCell) .Row + 1 count1 = 0 'Looping por todos os arquivos na pasta While filename "" count1 = count1 + 1 ReDim Preserve filearray (1 To count1) filearray ( contagem1) = nome do arquivo nome do arquivo = Dir () Wend On Error GoTo last 'Adicionando nome do arquivo à pasta de trabalho para i = 1 To UBound (filearray) Células (lastrow, 1) .Value = folderpath1 & filearray (i) lastrow = lastrow + 1 Next End If last: End Sub Sub getting_filelist_in_folder () 'Declarando variáveis ​​Dim folder_path As String Dim fso As Object, folder1, subfolder1 As Object' Obtendo o caminho da pasta folder_path = Sheet1.TextBox1.Value 'Verificando se o caminho da pasta contém barra invertida como último caractere If Right (folder_path, 1) " \ "Then folder_path = folder_path &" \ "End If 'Chamando subfolder_files macro Call subfolder_files (folder_path, True)' Criando objeto do objeto Sistema de arquivos Set fso = CreateObject (" scripting.filesystemobject ") Set subfolder1 = fso.getfolder (folder_path) 'Looping through each subfolder For Each folder1 In subfolder1.subfolders Call subfolder_files (folder1, True) Next End Sub 

Se você gostou deste blog, compartilhe com seus amigos no Facebook. Além disso, você pode nos seguir no Twitter e no Facebook.

Gostaríamos muito de ouvir de você, diga-nos como podemos melhorar nosso trabalho e torná-lo melhor para você. Escreva para nós no site de e-mail