none
VBA para cópia de arquivos do file server RRS feed

  • Pergunta

  • 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



    segunda-feira, 9 de fevereiro de 2015 18:50

Respostas

  • 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

    • Marcado como Resposta Davidson Araujo quarta-feira, 11 de fevereiro de 2015 13:15
    terça-feira, 10 de fevereiro de 2015 11:58
    Moderador

Todas as Respostas

  • 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

    • Marcado como Resposta Davidson Araujo quarta-feira, 11 de fevereiro de 2015 13:15
    terça-feira, 10 de fevereiro de 2015 11:58
    Moderador
  • 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.

    quarta-feira, 11 de fevereiro de 2015 13:17