como copiar carpetas en visual basic

[sepulman]

Hola, saben que deseo copiar una carpeta con todos sus archivos y sub carpetas a otro PC. saben cual puede ser el codigo desde visual para hacer eso.

Para copiar a otro PC pensaba ponerlo como una unidad mas, asi unidad Z = \10.10.10.99\C\

entonces copio desde c:\mis documentos\... y sub carpetas
hacia Z:\mis dociumentos\

Gracias

[sepulman]

ya encontre el codigo y lo comparto .


primero borro lo que hay en la carpeta, despues copio todo lo que encuentra, primero carpetas y despues todos los archivos.

lo unico que no pude es que si la carpeta no esta creada en el destino , no la crea, pero es un detalle si siempre esta creada.



Private Sub Form_Load()
Dim mensaje As String

Dim fso, MiArchivo


Set fso = CreateObject("Scripting.FileSystemObject")

Set MiArchivo = fso.deletefolder("c:\\mis documentos\\informe comercial\\*")

Set MiArchivo = fso.deletefile("c:\\mis documentos\\informe comercial\\*.*")

Set MiArchivo = fso.CopyFolder("I:\\informe comercial\\*", "C:\\mis documentos\\informe comercial\\", True)

Set MiArchivo = fso.CopyFile("I:\\informe comercial\\*.*", "C:\\mis documentos\\informe comercial\\", True)

end




saludos

[xexarrbd]

que tal .

me puedes echar a mano con un codigo .

lo que necesito es copiar una carpeta de un pc a otra pc

digamos "\\pc001\c:reporte diario "

necesito copiar toda a carpeta a \\pc002\C: reporte diario .

pero no se como !!


y pues solo tener dos botones ejecutar y salir !


Saludos !! y espero me puedes contesar

[pkj]

EDITADO

Como es algo que tambien a mi me interesaba he buscado un poco más y he modificado otro código para crear una función parecida al XCopy de MS-DOS:

Código vb:

Function XCopy(srcPath As String, dstPath As String, Optional FilePat As String = "*.*", Optional IncludeSubDirs As Boolean = True, Optional Sobreescribir As Boolean = True) As Integer
 
  ' Ejmp:
  ' XCopy "c:\p1", "d:\p1"
 
  ' funciona tambien en red:
  ' XCopy "//PC001/C/p1", "//PC002/C/p1"
 
 
  Const ATTR_DIRECTORY = 16
  
  Dim DirOK As Integer, i As Integer
  Dim DirReturn As String
  ReDim d(1) As String
  Dim dCount As Integer
  Dim CurrFile$
  Dim CurrDir$
  Dim dstPathBackup As String
  Dim f%
 
  On Error Resume Next
  
  MkDir dstPath
 
  If InStr(1, srcPath, "\") Or InStr(1, srcPath, ":") Then
    If Right(srcPath, 1) <> "\" Then srcPath = srcPath & "\"
  ElseIf InStr(1, srcPath, "/") Then
    If Right(srcPath, 1) <> "/" Then srcPath = srcPath & "/"
  End If
  If InStr(1, dstPath, "\") Or InStr(1, dstPath, ":") Then
    If Right(dstPath, 1) <> "\" Then dstPath = dstPath & "\"
  ElseIf InStr(1, dstPath, "/") Then
    If Right(dstPath, 1) <> "/" Then dstPath = dstPath & "/"
  End If
   
  On Error GoTo DirErr
   
  CurrDir$ = CurDir$ ' directorio actual de trabajo
  srcPath = UCase$(srcPath)
  dstPath = UCase$(dstPath)
 
  dstPathBackup = dstPath ' guardamos el directorio destino
   
  ' Iniciamos variables para mantener los nombres de archivos
  DirReturn = Dir(srcPath & "*.*", ATTR_DIRECTORY)
   
  ' Buscamos todos los Subdirectorios
  Do While DirReturn <> ""
    ' aseguramos que no se haga nada con "." y ".."
    If DirReturn <> "." And DirReturn <> ".." Then
      If (GetAttr(srcPath & DirReturn) And ATTR_DIRECTORY) = ATTR_DIRECTORY Then
        ' agregamos a la lista de directorios
        dCount = dCount + 1
        ReDim Preserve d(dCount)
        d(dCount) = srcPath & DirReturn
      End If
    End If
    DirReturn = Dir
  Loop
   
  ' ahora hacemos que los archivos que coicidan
  DirReturn = Dir(srcPath & FilePat, 0)
 
  ' Buscamos todos los archivos
  Do While DirReturn <> ""
    ' aseguramos que no es directorio
    If Not ((GetAttr(srcPath & DirReturn) And ATTR_DIRECTORY) = ATTR_DIRECTORY) Then
      ' es un archivo y se copia
      
      'Si existe miramos si se sobre-escribe
      On Error Resume Next
      f% = FreeFile
      Open dstPath & DirReturn For Input As #f%
      Close #f%
      If Err <> 0 Or Sobreescribir = True Then
        FileCopy srcPath & DirReturn, dstPath & DirReturn
      End If
    End If
    DirReturn = Dir
  Loop
 
   ' Ahora hacemos los subdirectorios
  For i = 1 To dCount
    If IncludeSubDirs Then
      On Error GoTo PathErr
      dstPath = dstPath & Right$(d(i), Len(d(i)) - Len(srcPath))
      ' si el path no existe lo creamos
      ChDir dstPath
      On Error GoTo DirErr
    Else
      XCopy = True
      GoTo ExitFunc
    End If
    DirOK = XCopy(d(i), dstPath, FilePat, IncludeSubDirs, Sobreescribir)
    ' Reiniciamos dstPath al valor asignado
    dstPath = dstPathBackup
  Next
 
  XCopy = True
 
ExitFunc:
  ChDir CurrDir$
  Exit Function
DirErr:
  MsgBox "Error: " & Error$(Err)
  XCopy = False
  Resume ExitFunc
PathErr:
  If Err = 75 Or Err = 76 Then ' si no encontramos el path
    MkDir dstPath
    Resume Next
  End If
  GoTo DirErr
End Function
 
Private Sub Command1_Click()
  XCopy "//PC001/C/reporte diario", "//PC002/C/reporte diario"
End Sub
 

Saludos