Excel Mover arquivos de uma pasta para outra atraves do VBA

[Janilson Brito]

Senhores, bom dia!

Tenho um planilha em Excel, onde a mesma faz atraves de uma macro a importacao de varios arquivos *.txt de um determinado diretorio.

porém o que eu gostaria de fazer é apos finalizar a importacao de todos os arquivos, fosse feita a movimentacao dos mesmos para uma pasta backup.

 

ex: \\nome_do_servidor\indicadores (diretorio de origem) onde fica todos os arquivos.

gostaria de mover todos arquivos *.txt desta pasta para \\nome_do_servidor\indicadores\backup

 

fazendo algumas pesquisas consegui chegar no codigo abaixo, porém não esta funcionando

 

Sub MoveArquivos()

  Dim fso 
  Dim PastaOrigem As String, PastaDestino As String
  
  PastaOrigem = "\\nome_do_servidor\INDICADORES"   
  PastaDestino = "\\nome_do_servidor\INDICADORES\backup" 
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  On Error Resume Next
  
  If Not fso.FolderExists(PastaOrigem) Then  
    MsgBox PastaOrigem & " Não é uma pasta válida.", vbInformation, "Office, VBA e VSTO"  
  ElseIf Not fso.FolderExists(PastaDestino ) Then  
    MsgBox PastaDestino & " Não é uma pasta válida.", vbInformation, "Office, VBA e VSTO"  
  Else  
    fso.MoveFile (PastaOrigem & "\*.txt"), PastaDestino  
  End If
  
  If Err.Number = 53 Then MsgBox "Arquivo não encontrado."

End Sub

[Basole]

@Janilson Brito experimente alterar esta linha no seu código, acrescentando uma barra invertida no final:

 

PastaDestino = "\\nome_do_servidor\INDICADORES\backup\" 

[Janilson Brito]

@Basole boa tarde! obrigado pelo retorno, fiz conforme indicado, colocando a "\" no final da linha, porém a macro não faz a movimentacao dos arquivos para pasta backup. permanencem todos na pasta de origem.

[Basole]

@Janilson Brito testei agora o seu codigo e pra mim está funcionando 100%

Pode ser que esteja acontecendo algum erro.  

Experimente "comentar" a linha: 'On Error Resume Next  => colocando uma aspas (') simples no inicio da linha. 

Desta forma se houver algum erro diferente do referenciado no codigo, apresentará.

 

Ou verifique se a pasta "backup" já foi criada.

 

 

[Janilson Brito]

Basole, obrigado pela dica, e desculpe a demora no novo teste.

Com a sua dica, consegui identificar que dava erro porque ja existia um arquivo com o mesmo nome no diretorio \backup, vou tentar ver como faço para que caso haja um arquivo com o mesmo nome, o mesmo seja substituido.

[Basole]

Fiz alterações no codigo, para verificar se o arquivo ja existe na pasta backup. 

Caso for verdadeiro, deleta o arquivo e move atualizando a pasta como o novo arquivo.

 

veja se atende

 

Sub MoveArquivos()

  Dim fso
  Dim PastaOrigem As String, PastaDestino As String
  Dim txtFile
  
  PastaOrigem = "\\nome_do_servidor\INDICADORES"
  PastaDestino = "\\nome_do_servidor\INDICADORES\backup"
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  
    On Error Resume Next
  
  If Not fso.FolderExists(PastaOrigem) Then
    MsgBox PastaOrigem & " Não é uma pasta válida.", vbInformation, "Office, VBA e VSTO"
  ElseIf Not fso.FolderExists(PastaDestino) Then
    MsgBox PastaDestino & " Não é uma pasta válida.", vbInformation, "Office, VBA e VSTO"
  Else
                    
  For Each txtFile In fso.GetFolder(PastaOrigem).Files
      If fso.FileExists(PastaDestino & txtFile.Name) Then
      fso.deletefile PastaDestino & txtFile.Name, True
       txtFile.Move PastaDestino
      End If
Next
    'fso.MoveFile (PastaOrigem & "\*.txt"), PastaDestino
  End If
  
  If Err.Number = 53 Then MsgBox "Arquivo não encontrado."

End Sub

 

[Janilson Brito]

Basole, mais uma vez muito obrigado por sua determinacao e nos ajudar, ficou exatamento como eu imaginava e precisava.