Crear exe para copiar

[darkstar666]

alguien que me ayude.
quiero crear un .exe para copiar archivos de la carpeta donde se encuentre el .exe.


por ejemplo tengo  la carpeta (imagenes) y ahi esta el .exe con otros archivos. cuando yo le de al .exe me copie lo que esta en la carpeta (imagenes) en otro direcotiro.
claro lo que quiero es que no sea una carpeta estatica sino que desde cualquier directorio que se encuentre la carpeta ejemplo (imagenes) siempre se copien los archivos a donde yo quiera. please help me

[79137913]

HOLA!!!

Para copiar carpetas que es lo que quieres hacer yo uso la funcion xCopy de pkj

Código (vb) [Seleccionar] Expandir

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] Expandir


Private Sub Command1_Click()
 XCopy AppPath, Text1.Text ' en text1 pones el path de destino (con este codigo incluis subcarpetas y sobreescribis)
End Sub

Espero que te sirva (¡Lee Bien los Paarametros de la Funcion!)

GRACIAS POR LEER!!!