Excel EXCEL - VBA para localizar, copiar e colar arquivos de um diretório em outro

[Cfernandes]

Boa tarde! Pessoal, preciso de uma ajuda para desenvolver uma amcro que localize, copie e cole arquivos de acordo com duas variáveis que eu informo, entretanto os arquivos estão em umas 5 pastas diferentes.
 

No arquivo “Planilha” possui os dados das NFS-e que preciso localizar em uma pasta e salvar em outra. Entretanto são somente os arquivos listados dentro da planilha.

Então as NFS-e do arquivo Planilha, precisam ser localizados em: Dados\NFS-e\NFS-e\Tributario\Fiscal\Setores\NF de entrada\NF compras\2021

E salvas em: Dados\Apuração_1\Notas Salvas


Variáveis:

Os arquivos não tem um padrão de nomenclatura;

Alguns arquivos não tem o “Pedido” no nome do arquivo, nesse caso precisava que retornasse na planilha essa informação;

O “Número da NFS-e pode repetir, mas o “Pedido” não - Exemplo: NF 19093 (salvo na pasta) que possui várias NFS-e com número 19093, mas com pedidos diferentes

As NFs-e são salvas por dia dentro de casa mês;

Alguns arquivos possuem o nome “Pedido” como PO – Exemplo: NF 29878_ PO 247183

Alguns arquivos não possuem espaços entre os nomes, ou utilizam underline - Exemplo: nf 34pedido 134657 e NF4319_494949

 

Alguns arquivos com mesmo número, exemplo 3 arquivos com o número 3456, gostaria que copiasse os 3 ou me informasse que tem mais de um arquivo com esse número.

 

Aviso:

Quando não localizar um arquivo, favor informar na planilha;

 

Dados.zip

[Midori]

@Camila Haubert Veja se é algo assim que precisa. O código faz a busca em todas as subpastas de 2021. Não implementei a mensagem dos arquivos copiados, o código é mais para testar se está copiando os arquivos corretamente como comentou,

 

Const SUBPASTA_2021 As String = _
    "\NFS-e\NFS-e\Tributario\Fiscal\" & _
    "Setores\NF de entrada\NF compras\2021\"

Sub ListaPastas(Pasta As Object, Celula As Range)
    Dim Arquivo     As Object
    Dim SubPasta    As Object
  
    For Each Arquivo In Pasta.Files
        If InStr(Arquivo.Name, Celula.Offset(0, 1)) <> 0 Then
            If InStr(Arquivo.Name, Celula) <> 0 Then
                Call Arquivo.Copy(ThisWorkbook.Path & _
                    "\Apuração_1\Notas Salvas\")
                Celula.Offset(0, 3) = 1
            End If
        End If
    Next Arquivo
    
    For Each SubPasta In Pasta.SubFolders
        Call ListaPastas(SubPasta, Celula)
    Next SubPasta
End Sub

Sub Macro()
    Dim Fso     As Object
    Dim Celula  As Range
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Celula = [A2]
    
    While Celula <> ""
        Call ListaPastas( _
            Fso.GetFolder(ThisWorkbook.Path & _
            SUBPASTA_2021), Celula)
        Set Celula = Celula.Offset(1)
    Wend
End Sub

 

[Cfernandes]

@Midori Nossa! Eu estou sem palavras até agora, funcionou muito bem!

Até com a quantidade na lateral! Estou impressionada! 

 

Funcionou muito bem, testei com 200 arquivos e funcionou perfeitamente!

 

Muito, mas muito obrigada mesmo!

[Cfernandes]

Em 31/08/2021 às 17:08, Midori disse:

 Fso.GetFolder(ThisWorkbook.Path & _
            SUBPASTA_2021), Celula)

Poderia por gentileza, me explicar essa parte?

[Midori]

@Camila Fernandes Esses são os argumentos da Sub ListaPastas. Veja que essa Sub tem dois parâmetros: Pasta e Celula.

 

O primeiro argumento passado é GetFolder onde passei o caminho onde está a pasta 2021 (concatenei o caminho da planilha com o da subpasta até 2021) e o segundo é referente a célula da coluna A que fica em loop até chegar ao fim da tabela.

 

[Cfernandes]

@Midori Certo, estou tentando aplicar para salvamento de outros arquivos também, entretanto está apresentando o erro "Caminho não localizado".

 

Vou modificar os nomes das pastas por ser pessoal, em negrito e sublinhado são as pastas 

 

seria basicamente assim:

 

Local de procura dos arquivos: X:\Pasta1\Pasta2\Exemplo1\Exemplo2\Exemplo3\2021

 

A planilha ficaria salvo no mesmo caminho praticamente onde serão copiados e salvos os arquivos, entretanto dentro de uma pasta as NFS-e (como na imagem):

 

Local de salvamento da planilha: X:\Pasta1\Pasta2\Pasta3\Pasta4\Pasta5\Pasta6\Pasta7\Pasta8\Pasta9\

 

Local de salvamento dos arquivos copiados: X:\Pasta1\Pasta2\Pasta3\Pasta4\Pasta5\Pasta6\Pasta7\Pasta8\Pasta9\NFS-e

[Midori]

@Camila Fernandes O caminho da planilha da macro também é considerado no caminho completo. A única edição a ser feita no caso de outra estrutura de pastas é na constante PASTA_2021 e, se necessário, na sub pasta onde os arquivos serão salvo.

 

Mas se a estrutura for a mesma e a pasta está em algum nível acima de 2021 ("NF Compras", p.ex), nesse caso é só remover a 2021 da constante e deixar a NF Compras como a última pasta do caminho. Assim, considerando a estrutura do anexo, a macro iria procurar os arquivos em cada ano que tiver uma pasta.