Este fórum está sendo desativado

[JulioMangilli]

Olá estou tentando transferir alguns arquivos .txt de uma pasta para outra porem sem sucesso.

Poderiam me ajudar? Ele me retorno o erro 53.
Porem os caminhos dou certeza que estão certo, mas acredito que estou errando no formato do arquivo a identificar, porem não sei realmente o que pode ser ahauhauahu somente um chute.

Sub Moverarquivos2()

Dim Origem As String
Dim Destino As String

Origem = "C:\Users\User\Documents\Documentos Julio\Importador\Arquivos para Importar\*.txt"
Destino = "C:\Users\User\Documents\Documentos Julio\Importador\Arquivos para Impotados\*.txt"

FileCopy Origem, Destino


End Sub


Desde já Obrigado

[WillianVictor]

Fala, @JulioMangilli!
Beleza?

Cara, vê se esse algoritmo te atende.
Só modificar os caminhos, conforme sua necessidade, e habilitar o Microsoft Scripting Runtime para reconhecer o FSO.

Código: Selecionar todos

Public Function ListaArquivos(ByVal Caminho As String) As String()
    'Atenção: Faça referência à biblioteca Micrsoft Scripting Runtime
    Dim FSO As New FileSystemObject
    Dim result() As String
    Dim Pasta As Folder
    Dim Arquivo As File
    Dim Indice As Long
 
 
    ReDim result(0) As String
    If FSO.FolderExists(Caminho) Then
        Set Pasta = FSO.GetFolder(Caminho)
 
        For Each Arquivo In Pasta.Files
            Indice = IIf(result(0) = "", 0, Indice + 1)
            ReDim Preserve result(Indice) As String
            result(Indice) = Arquivo.Name
        Next
    End If
 
    ListaArquivos = result
ErrHandler:
    Set FSO = Nothing
    Set Pasta = Nothing
    Set Arquivo = Nothing
End Function

Sub ListarArquivos()
' /// Executar esse Sub chamando a Function ListaArquivos
    Dim arquivos() As String
    Dim lCtr As Long
    
' /// Mude o caminho Origem aqui
    arquivos = ListaArquivos("C:\Users\2103894150\Desktop\path1")
    Worksheets.Add
    ActiveSheet.Name = "FileName_Log_" & Rnd
    For lCtr = 0 To UBound(arquivos)
      Cells(lCtr + 1, 1) = arquivos(lCtr)
    Next
    
    Dim Origem, Destino As String, ulin As Integer
    
    ulin = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To ulin
        ' /// If para validar se o arquivo é formato ".txt"
        If Right$(Cells(i, 1), 4) = ".txt" Then
        ' /// Mude o caminho Origem aqui
            Origem = "C:\Users\2103894150\Desktop\path1\" & Cells(i, 1).Value
        ' /// Mude o caminho Destino aqui
            Destino = "C:\Users\2103894150\Desktop\path2\" & Cells(i, 1).Value
            FileCopy Origem, Destino
        End If
    Next
    
End Sub

Fiz uma adaptação do código original do Thomas Vasquez que ao invés de listar em debug, lista na planilha e depois percorre a listagem copiando e gravando os arquivos iguais à .txt.
Código fonte para listagem de arquivos: https://www.tomasvasquez.com.br/blog/mi ... diretorio/

Belezinha?
Qualquer coisa, avisaê.
Abs.