none
Pesquisar, identificar, copiar o arquivo mais recente e colar arquivos txt/csv de um diretório para outro em Vb RRS feed

  • Pergunta

  • Olá!

    Pessoal, preciso de ajuda para automatizar uma parte da rotina aqui da área.

    Diariamente, a equipe de T.I. gera 5 arquivos (em txt ou csv) e coloca na pasta A. O nome de cada arquivo segue o padrão NOMEDOARQUIVO_DDMMAAAA_HHMM (sendo DDMMAAA_HHMM o DiaMesAno_HoraMinuto que o arquivo foi gerado) e a pasta guarda 30 dias de histórico.

    Uma pessoa da equipe entra na pasta A e copia apenas 3 dos 5 arquivos, mas apenas o arquivos mais recentes, e cola em outra pasta (pasta B) renomeando cada arquivo para NOMEDOARQUIVO.

    A partir da dai, eu criei uma rotina no access usando vba para importar os arquivos para o access (pasta B - NOMEARQUIVO), atualizar alguns relatórios e enviar um e-mail informando que os relatórios estão atualizados e disponível na rede.

    Alguém sabe como eu copio 3 dos 5 arquivos da pasta A, sempre o mais atual, e colo estes arquivos com outro nome na pasta B, usando VBA? 

    Obrigado e abraço!

    Bruno

    terça-feira, 28 de julho de 2015 20:07

Respostas

  • Olá,

    colem isso em um módulo, alterem os caminhos de origem e destino....

    Se o padrão dos nomes dos arquivos estiver da forma descrita, vai dar certo.

    Sub voidBuscarArquivos()
    
      Dim FileSystem As Object
      Dim Folder As Object
      Dim File As Variant
      Dim strCaminho As String
      Dim strCaminhoDestino As String
      Dim strArquivo As String
      
      Dim strDataHora As String
      
      
      Set FileSystem = CreateObject("Scripting.FileSystemObject")
      
      strCaminho = ThisWorkbook.Path & "\PastaOrigem\"
      strCaminhoDestino = ThisWorkbook.Path & "\PastaDestino\"
      
      Set Folder = FileSystem.GetFolder(strCaminho)
    
      Dim arr() As String
      
      For Each File In Folder.Files
          
          strDataHora = Mid(File.Name, InStr(File.Name, "_") + 1, 13)
          
          ReDim Preserve arr(i)
          arr(i) = Left(Right(strDataHora, 9), 4) & Left(strDataHora, 4) & Right(strDataHora, 4) & "/" & File.Name
          i = i + 1
    
      Next
      
      voidSortArray arr 'Ordena o array Criado
      
      
      For i = 0 To 2
      
        strArquivo = Right(arr(i), Len(arr(i)) - 13) 'retiro da string completa somente o nome do arquivo
        FileCopy strCaminho & strArquivo, strCaminhoDestino & "outroNome_" & strArquivo
        
      Next i
      
    End Sub
    
    Sub voidSortArray(arr)
    
      Dim strTemp As String
      Dim i As Long
      Dim j As Long
      Dim lngMin As Long
      Dim lngMax As Long
      lngMin = LBound(arr)
      lngMax = UBound(arr)
      
      For i = lngMin To lngMax - 1
        For j = i + 1 To lngMax
          If arr(i) > arr(j) Then
            strTemp = arr(i)
            arr(i) = arr(j)
            arr(j) = strTemp
          End If
        Next j
      Next i
      
    End Sub
    


    Natan

    sábado, 1 de agosto de 2015 12:01

Todas as Respostas

  • Também preciso fazer a mesma coisa, vamos ver se alguém ajuda. Acredito que tem que criar uma rotina que compare os dois arquivos das pastas A e B e verifique a data, se a data da pasta A for mais recente copia o arquivo. Vou ver pesquisar mais e se descobrir alguma coisa posto aqui.

    sexta-feira, 31 de julho de 2015 19:42
  • Olá,

    colem isso em um módulo, alterem os caminhos de origem e destino....

    Se o padrão dos nomes dos arquivos estiver da forma descrita, vai dar certo.

    Sub voidBuscarArquivos()
    
      Dim FileSystem As Object
      Dim Folder As Object
      Dim File As Variant
      Dim strCaminho As String
      Dim strCaminhoDestino As String
      Dim strArquivo As String
      
      Dim strDataHora As String
      
      
      Set FileSystem = CreateObject("Scripting.FileSystemObject")
      
      strCaminho = ThisWorkbook.Path & "\PastaOrigem\"
      strCaminhoDestino = ThisWorkbook.Path & "\PastaDestino\"
      
      Set Folder = FileSystem.GetFolder(strCaminho)
    
      Dim arr() As String
      
      For Each File In Folder.Files
          
          strDataHora = Mid(File.Name, InStr(File.Name, "_") + 1, 13)
          
          ReDim Preserve arr(i)
          arr(i) = Left(Right(strDataHora, 9), 4) & Left(strDataHora, 4) & Right(strDataHora, 4) & "/" & File.Name
          i = i + 1
    
      Next
      
      voidSortArray arr 'Ordena o array Criado
      
      
      For i = 0 To 2
      
        strArquivo = Right(arr(i), Len(arr(i)) - 13) 'retiro da string completa somente o nome do arquivo
        FileCopy strCaminho & strArquivo, strCaminhoDestino & "outroNome_" & strArquivo
        
      Next i
      
    End Sub
    
    Sub voidSortArray(arr)
    
      Dim strTemp As String
      Dim i As Long
      Dim j As Long
      Dim lngMin As Long
      Dim lngMax As Long
      lngMin = LBound(arr)
      lngMax = UBound(arr)
      
      For i = lngMin To lngMax - 1
        For j = i + 1 To lngMax
          If arr(i) > arr(j) Then
            strTemp = arr(i)
            arr(i) = arr(j)
            arr(j) = strTemp
          End If
        Next j
      Next i
      
    End Sub
    


    Natan

    sábado, 1 de agosto de 2015 12:01