[Resolvido]Copiar arquivos de pastas via VBA

Bom dia Pessoal,

Estou precisando de uma ajuda talvez alguém já passou por isto. Preciso copiar arquivos dentro de subpastas o qual os nomes começam com "EXT" para uma outra pasta de nome "ARQUIVO".

Ex:
           Pasta 1
                       Pasta 1.1
                                        EXT texto.xls
                                        ETT texto.doc
                                        EXT texto2.xls
                                        ...
                       Pasta 1.2
                                        TFT texto.xls
                                        TIF texti.docx
                                        EXT textk.xls


Teria pegar todos os arquivos que começam com "EXT" que estivessem dentro das subpastas da pasta 1 e copiá-los para uma pasta de nome ARQUIVO.

As subpastas não seguem um padrão de nomenclatura.


Alguém pode me ajudar?


Agradeço.

Olá, pode tentar com o xcopy do sistema operarivo.
Fazendo uma chamada via shell
Ex:
Xcopy c:\pasta1\Ext*.* c:\Arquivo /s
Não testado, estou no telemóvel.
Caso tenha duvidas efetue uma pesquisa:
Xcopy
Vba shell

Abraço

Boa tarde ahteixeira,

O problema que os arquivos estão dentro de outras pastas dentro desta pasta raiz "Pasta1".

Testei aqui e funcionou beleza, porém ele está trazendo o arquivo não solto na pasta e sim copiando a subpasta com ele dentro.

Olá Wagner Paula,

Para esse efeito será melhor via código.
A questão está se tem o mesmo nome de ficheiro em várias sub-pastas.
Pois só permite um arquivo com o mesmo nome na pasta destino.

Com base no seguinte artigo: http://forum.chandoo.org/threads/copy-all-the-files-from-folder-and-subfolder-to-one.15698/
fiz uma alteração e acho que atende o pretendido:

Código:

Sub copiarParaPasta(pastaOrigem)
'reque referencia: Microsoft Scripting Runtime
'origem código: http://forum.chandoo.org/threads/copy-all-the-files-from-folder-and-subfolder-to-one.15698/
'adaptado por: Alvaro Teixeira (ahteixeira) para MaximoAccess em 02-09-2016


Dim fs, f, f1, fc, s, sFldr
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(pastaOrigem)
Set fc = f.SubFolders

    For Each f1 In fc
        copiarParaPasta f1
    Next
    Set fc = f.Files
    For Each f1 In fc
        FileCopy pastaOrigem & "\" & f1.Name, "C:\PastaDestino" & "\" & f1.Name
    Next

End Sub

Nota: deve ter a pasta destino criada, pode melhorar o código e fazer automáticamente.
Abraço

Boa tarde,

Funcionou beleza.

Agradeço.

Olá Wagner Paula,
Obrigado pelo retorno.
Abraço