HOLA!!!
Para copiar carpetas que es lo que quieres hacer yo uso la funcion xCopy de pkj
Y, para que sea como vos decis que copie siempre lo que esta en la carepeta de el yo haria asi:
Espero que te sirva (¡Lee Bien los Paarametros de la Funcion!)
GRACIAS POR LEER!!!
Para copiar carpetas que es lo que quieres hacer yo uso la funcion xCopy de pkj
Código (vb) [Seleccionar]
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
Y, para que sea como vos decis que copie siempre lo que esta en la carepeta de el yo haria asi:
Código (vb) [Seleccionar]
Private Sub Command1_Click()
XCopy AppPath, Text1.Text ' en text1 pones el path de destino (con este codigo incluis subcarpetas y sobreescribis)
End SubEspero que te sirva (¡Lee Bien los Paarametros de la Funcion!)
GRACIAS POR LEER!!!
