VBA para cópia de arquivos do file server

Question

Olá,

Preciso de copiar alguns (28.000) arquivos de um servidor remoto para meu desktop.

Tenho a listagem dos arquivos que preciso em Excel e criei uma macro para realizar a cópia, porém recebo a mensagem de "Permissão Negada." Meu login tem perfil de ADM no server e local.

Tenho que incluir alguma linha de comando na macro para liberar a cópia?

Sub copy()

Dim origem, destino As String
Dim i As Integer
Dim fso As FileSystemObject


Set fso = CreateObject("Scripting.FileSystemObject")

destino = "C:\temp"

For i = 2 To 5

origem = "y:\" & Plan1.Range("I" & i)


If fso.FileExists(origem) Then
    fso.CopyFile origem, destino
    Plan1.Range("H" & i) = "Copiado"
Else
    Plan1.Range("H" & i) = "Arquivo não encontrado"
End If

Next
End Sub

Obrigado!

Davidson Araujo

Answer 1

Olá Davidson, eu trabalhava na MJ e lembro de você, tudo bem?

No seu caso, a string 'origem' não pode representar apenas o diretório onde o arquivo será copiado, mas sim seu caminho completo. Experimente:

Sub copy()
  
  Dim origem, destino As String
  Dim i As Integer
  Dim fso As FileSystemObject
  
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  
  For i = 2 To 5
    
    origem = "y:\" & Plan1.Range("I" & i)
    destino = "C:\temp\" & Plan1.Range("I" & i)
    
    If fso.FileExists(origem) Then
      fso.CopyFile origem, destino
      Plan1.Range("H" & i) = "Copiado"
    Else
      Plan1.Range("H" & i) = "Arquivo não encontrado"
    End If
    
    Next
End Sub

---

Se não funcionar, tente essa alternativa:

Sub CopyFiles()
  Dim origem As String
  Dim destino As String
  Dim lRow As Long
  
  
  For lRow = 2 To 5
    origem = "y:\" & Plan1.Cells(lRow, "I")
    destino = "C:\temp\" & Plan1.Cells(lRow, "I")
    
    If FileExists(origem) Then
      FileCopy origem, destino
      Plan1.Cells(lRow, "H") = "Copiado"
    Else
      Plan1.Cells(lRow, "H") = "Arquivo não encontrado"
    End If
    
  Next lRow
End Sub

Private Function FileExists(filePath As String) As Boolean
  FileExists = Dir(filePath) <> ""
End Function

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 2

Olá Felipe, tudo tranquilo e contigo?

O problema era este mesmo, apesar de ter uma função de "filecopy", se não passar o nome para o arquivo de destino não funciona.

Valeu.