Visual Basic - Copiar Directorios

Como puedo copiar directorios o carpetas enteras, no fichero a fichero con Filecopy

Un saludo,
Carlos

Copiar todos los ficheros desde un directorio a otro

1. Crear un nuevo proyecto en Visual Basic por defecto es "Form1"
2. Añadir el siguiente codigo al evento "Form_load" del Form1

Private Sub Form_Load()
text1.Text = ""
text2.Text = ""
End Sub

3. Añadir un label control al form1, por defecto es label1, escribir en
propiedades Caption "Directorio Fuente"
4. Añadir un segundo label control al form1, por defecto es label2, escribir
en propiedades Caption "Directorio de Destino"
5. Añadir un control "Text Box" al Form1, por defecto será Text1
6. Añadir un segundo control "Text Box", por defecto será Text2
7. Añadir un boton al Form1 "Command Button" en propiedades caption
escribir "Copiar Ficheros"
8. Añadir el siguiente codigo al evento "Click" de Command1:

Private Sub Command1_Click()
Dim SourceDir As String
Dim TargetDir As String
Dim X As Integer
Dim P As Integer

SourceDir = text1.Text
TargetDir = text2.Text
CopyFile SourceDir, TargetDir, P
MsgBox "Numeros de ficheros copiados = " & Str$(P)
End Sub

9. Crear una nueva subrutina llamada CopyFile y añadirle el codigo siguiente.

Sub CopyFile(SrcDir As String, TrgtDir As String, NumFiles As Integer)
Dim OldDir As String
Dim NewDir As String
Dim FileName As String
Dim sType As String
OldDir = SrcDir
If Right$(OldDir, 1) <> "\" Then
OldDir = OldDir & "\"
End If
NewDir = TrgtDir
If Right$(NewDir, 1) <> "\" Then
NewDir = NewDir & "\2

Sustituye la última línea del anterior por la primera de éste.

NewDir = NewDir & "\"
End If

NumFiles = 0
FileName = Dir$(OldDir & "*.*")
While FileName <> ""
On Error Resume Next
FileCopy (OldDir & FileName), (NewDir & FileName)
If Err = 0 Then
NumFiles = NumFiles + 1
Else
Beep
MsgBox Error$, VBEXCLAMATION, ("Error copiando fichero " & FileName)
End If
On Error GoTo 0
FileName = Dir$
DoEvents
Wend
End Sub

Muchas gracias tecniCam me ha servido mucho

saludos,
Carlos