COPIAR DIRETÓRIO PARA PENDRIVE

[TARSA]

Boa noite,

Preciso criar um código que copie todo o conteúdo de um determinado diretório e sub diretórios do meu P.C e o sobrescreva no meu pendrive, mas não estou obtendo exito. Estou usando a seguinte linha:

Sub Copiar_dir()

Shell "cmd /c xcopy /y /e C:\ORIGEM\*.* F:\DESTINO\"

End Sub

Alguém pode me dar uma ajuda?

[Mikel Silveira Fraga]

Tarsa, bom dia.

Veja se esse vídeo não lhe ajuda com essa operação. Segue link abaixo:
- Manipulando Diretórios e Arquivos

Dúvidas, a disposição.

[Reinaldo]

Costumo utiliza rotinas obtidas no site de Rondebruin: http://www.rondebruin.nl/folder.htm
Experimente

Código: Selecionar todos

Sub Copy_Folder()
'This example copy all files and subfolders from FromPath to ToPath.
'Note: If ToPath already exist it will overwrite existing files in this folder
'if ToPath not exist it will be made for you.
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String

    FromPath = "C:\Users\Ron\Data"  '<< Change
    ToPath = "C:\Users\Ron\Test"    '<< Change

    'If you want to create a backup of your folder every time you run this macro
    'you can create a unique folder with a Date/Time stamp.
    'ToPath = "C:\Users\Ron\" & Format(Now, "yyyy-mm-dd h-mm-ss")

    If Right(FromPath, 1) = "\" Then
        FromPath = Left(FromPath, Len(FromPath) - 1)
    End If

    If Right(ToPath, 1) = "\" Then
        ToPath = Left(ToPath, Len(ToPath) - 1)
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If
    FSO.CopyFolder Source:=FromPath, Destination:=ToPath
    MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath
End Sub

[TARSA]

Prezados,

Mikel e Reinaldo, adaptei os códigos e referências postadas por vocês e está funcionando perfeitamente. Muito obrigado.