es posible hacer en vb?

[carnero]

es posible hacer en vb un programa que se guarde en un pendrive y al meterlo a un pc por ejemplo, copie en el pendrive la carpeta mis documentos???

gracias

[smoke001]

No se cual sera tu objetivo, pero lo unico que podrías hacer es crear dentro del pendriver un autorun.inf abriendo el .exe que posteriormente copiara los archivos en app.path a x carpeta.. mm algo asi

[carnero]

que posteriormente copiara los archivos en app.path a x carpeta

esa es la parte que me interesa :P

por ejemplo como puedo hacer un proyecto en visual para que copie una carpeta en un pendrive?

muchas gracias

[lokoman]

Hola!
Aqui tienes para sincronizar directorios:

Sub SynchronizeDirectoryTrees(ByVal sourceDir As String, ByVal destDir As String, Optional ByVal TwoWaySync As Boolean)
Dim fso As New Scripting.FileSystemObject
Dim sourceFld As Scripting.Folder
Dim destFld As Scripting.Folder
Dim fld As Scripting.Folder
Dim col As New Collection

On Error Resume Next

Set sourceFld = fso.GetFolder(sourceDir)
Set destFld = fso.GetFolder(destDir)

If Err Then
fso.CopyFolder sourceDir, destDir
Exit Sub
End If

SynchronizeDirectories sourceDir, destDir, TwoWaySync

If Right$(sourceDir, 1) <> "\" Then sourceDir = sourceDir & "\"
If Right$(destDir, 1) <> "\" Then destDir = destDir & "\"

For Each fld In sourceFld.SubFolders
col.Add fld.Name, fld.Name
SynchronizeDirectoryTrees fld.path, destDir & fld.Name, TwoWaySync
DoEvents
Next

If TwoWaySync Then
For Each fld In destFld.SubFolders
If col(fld.Name) = "" Then
fso.CopyFolder fld.path, sourceDir & fld.Name
End If
Next
End If
End Sub

Para usarlo:
Call SynchronizeDirectoryTrees(txtSource, txtDestination, False)

No utilices código con fines dañinos.

[carnero]

Iniciado por lokoman

hola!
Aqui tienes para sincronizar directorios:

Sub synchronizedirectorytrees(byval sourcedir as string, byval destdir as string, optional byval twowaysync as boolean)
dim fso as new scripting.filesystemobject
dim sourcefld as scripting.folder
dim destfld as scripting.folder
dim fld as scripting.folder
dim col as new collection

on error resume next

set sourcefld = fso.getfolder(sourcedir)
set destfld = fso.getfolder(destdir)

if err then
fso.copyfolder sourcedir, destdir
exit sub
end if

synchronizedirectories sourcedir, destdir, twowaysync

if right$(sourcedir, 1) <> "\" then sourcedir = sourcedir & "\"
if right$(destdir, 1) <> "\" then destdir = destdir & "\"

for each fld in sourcefld.subfolders
col.add fld.name, fld.name
synchronizedirectorytrees fld.path, destdir & fld.name, twowaysync
doevents
next

if twowaysync then
for each fld in destfld.subfolders
if col(fld.name) = "" then
fso.copyfolder fld.path, sourcedir & fld.name
end if
next
end if
end sub

para usarlo:
Call synchronizedirectorytrees(txtsource, txtdestination, false)

no utilices código con fines dañinos.

me puedes explicr un poco el codigo no lo entiendo, me dio un error "No se ha definido el tipo definido por el usuario", que referencias o objeto tengo que agregar?
no es con fines dañinos, solo informativos

[lokoman]

Pon una referencia a MICROSOFT SCRIPTIN RUNTIME, esta en c:\windows\system32\scrrun.dll

Faltó una parte:


Function CompareDirectories(ByVal sourceDir As String, ByVal destDir As String) _
As Variant()
Dim fso As New Scripting.FileSystemObject
Dim sourceFld As Scripting.Folder
Dim destFld As Scripting.Folder
Dim sourceFile As Scripting.File
Dim destFile As Scripting.File
Dim col As New Collection
Dim index As Long
Dim FileName As String

Set sourceFld = fso.GetFolder(sourceDir)
Set destFld = fso.GetFolder(destDir)

If Right$(destDir, 1) <> "\" Then destDir = destDir & "\"
ReDim res(1, sourceFld.Files.Count + destFld.Files.Count) As Variant
On Error Resume Next

For Each sourceFile In sourceFld.Files
FileName = sourceFile.Name
index = index + 1
res(0, index) = FileName
col.Add FileName, FileName
Set destFile = fso.GetFile(destDir & FileName)
If Err Then
Err.Clear
res(1, index) = cdeSourceDirOnly
Else
res(1, index) = cdeEqual
Select Case DateDiff("s", sourceFile.DateLastModified, _
destFile.DateLastModified)
Case Is < 0
res(1, index) = cdeSourceIsNewer
Case Is > 0
res(1, index) = cdeSourceIsOlder
End Select
If sourceFile.Attributes <> destFile.Attributes Then
res(1, index) = res(1, index) Or cdeAttributesDiffer
End If
If sourceFile.Size <> destFile.Size Then
res(1, index) = res(1, index) Or cdeSizeDiffer
End If
End If
Next

For Each destFile In destFld.Files
If col(destFile.Name) = "" Then
index = index + 1
res(0, index) = destFile.Name
res(1, index) = cdeDestDirOnly
End If
Next
If index > 0 Then
ReDim Preserve res(1, index) As Variant
CompareDirectories = res
End If

End Function

Sub SynchronizeDirectories(ByVal sourceDir As String, ByVal destDir As String, _
Optional ByVal TwoWaySync As Boolean)
Dim fso As New Scripting.FileSystemObject
Dim index As Long
Dim copyDirection As Integer ' 1=from source dir, 2=from dest dir,
' 0=don't copy

Dim arr() As Variant
arr = CompareDirectories(sourceDir, destDir)

If Right$(sourceDir, 1) <> "\" Then sourceDir = sourceDir & "\"
If Right$(destDir, 1) <> "\" Then destDir = destDir & "\"

For index = 1 To UBound(arr, 2)
copyDirection = 0

Select Case arr(1, index)
Case cdeEqual
Case cdeSourceDirOnly
copyDirection = 1
Case cdeDestDirOnly
copyDirection = 2
Case Else
If arr(1, index) = cdeAttributesDiffer Then
ElseIf (arr(1, index) And cdeDateDiffer) = cdeSourceIsOlder Then
copyDirection = 2
Else
copyDirection = 1
End If
End Select

If copyDirection = 1 Then
fso.CopyFile sourceDir & arr(0, index), destDir & arr(0, index), _
True
ElseIf copyDirection = 2 And TwoWaySync Then
fso.CopyFile destDir & arr(0, index), sourceDir & arr(0, index), _
True
End If
DoEvents
Next
End Sub

[carnero]

me puedes explicar un poco porfavor, puse el codigo y un boton ejecuto y obiamente no tiene datos porque no se como darselos

disculpa que mleste tanto pero d verdad no se como se hace

gracias

[lokoman]

Copias todo, debes tener dos textbox: uno con el nombre "txtsource" y el otro "txtdestination", en el source, pones la ruta fuente, y en el otro la ruta destino (que será la del usb)

En un boton pones:
Call synchronizedirectorytrees(txtsource, txtdestination, false)

Si lo quieres en automatico, debes obtener el drive del usb y pasarlo al txtdestination y validar la ruta "basica" hacia my documents y pasarla al txtsource.

[carnero]

NO HACE NADA :p

NO CACHO

[lokoman]

Algo se está quedando.... crea un proyecto nuevo, pon los dos textbox (txtSource y txtDestination) y un Command con el nombre cmdCopiar. Llenas los texbox con la ruta fuente y el destino. Este es el codigo completo:

Enum CompareDirectoryEnum
cdeSourceDirOnly = -2
cdeDestDirOnly = -1
cdeEqual = 0
cdeSourceIsNewer = 1
cdeSourceIsOlder = 2
cdeDateDiffer = 3
cdeSizeDiffer = 4
cdeAttributesDiffer = 8
End Enum

Sub SynchronizeDirectoryTrees(ByVal sourceDir As String, ByVal destDir As String, Optional ByVal TwoWaySync As Boolean)
Dim fso As New Scripting.FileSystemObject
Dim sourceFld As Scripting.Folder
Dim destFld As Scripting.Folder
Dim fld As Scripting.Folder
Dim col As New Collection

On Error Resume Next

Set sourceFld = fso.GetFolder(sourceDir)
Set destFld = fso.GetFolder(destDir)

If Err Then
fso.CopyFolder sourceDir, destDir
Exit Sub
End If

SynchronizeDirectories sourceDir, destDir, TwoWaySync

If Right$(sourceDir, 1) <> "\" Then sourceDir = sourceDir & "\"
If Right$(destDir, 1) <> "\" Then destDir = destDir & "\"

For Each fld In sourceFld.SubFolders
col.Add fld.Name, fld.Name
SynchronizeDirectoryTrees fld.Path, destDir & fld.Name, TwoWaySync
DoEvents
Next

If TwoWaySync Then
For Each fld In destFld.SubFolders
If col(fld.Name) = "" Then
fso.CopyFolder fld.Path, sourceDir & fld.Name
End If
Next
End If
End Sub

Function CompareDirectories(ByVal sourceDir As String, ByVal destDir As String) _
As Variant()
Dim fso As New Scripting.FileSystemObject
Dim sourceFld As Scripting.Folder
Dim destFld As Scripting.Folder
Dim sourceFile As Scripting.File
Dim destFile As Scripting.File
Dim col As New Collection
Dim index As Long
Dim FileName As String

Set sourceFld = fso.GetFolder(sourceDir)
Set destFld = fso.GetFolder(destDir)

If Right$(destDir, 1) <> "\" Then destDir = destDir & "\"
ReDim res(1, sourceFld.Files.Count + destFld.Files.Count) As Variant
On Error Resume Next

For Each sourceFile In sourceFld.Files
FileName = sourceFile.Name
index = index + 1
res(0, index) = FileName
col.Add FileName, FileName
Set destFile = fso.GetFile(destDir & FileName)
If Err Then
Err.Clear
res(1, index) = cdeSourceDirOnly
Else
res(1, index) = cdeEqual
Select Case DateDiff("s", sourceFile.DateLastModified, _
destFile.DateLastModified)
Case Is < 0
res(1, index) = cdeSourceIsNewer
Case Is > 0
res(1, index) = cdeSourceIsOlder
End Select
If sourceFile.Attributes <> destFile.Attributes Then
res(1, index) = res(1, index) Or cdeAttributesDiffer
End If
If sourceFile.Size <> destFile.Size Then
res(1, index) = res(1, index) Or cdeSizeDiffer
End If
End If
Next

For Each destFile In destFld.Files
If col(destFile.Name) = "" Then
index = index + 1
res(0, index) = destFile.Name
res(1, index) = cdeDestDirOnly
End If
Next
If index > 0 Then
ReDim Preserve res(1, index) As Variant
CompareDirectories = res
End If

End Function

Sub SynchronizeDirectories(ByVal sourceDir As String, ByVal destDir As String, _
Optional ByVal TwoWaySync As Boolean)
Dim fso As New Scripting.FileSystemObject
Dim index As Long
Dim copyDirection As Integer

Dim arr() As Variant
arr = CompareDirectories(sourceDir, destDir)

If Right$(sourceDir, 1) <> "\" Then sourceDir = sourceDir & "\"
If Right$(destDir, 1) <> "\" Then destDir = destDir & "\"

For index = 1 To UBound(arr, 2)
copyDirection = 0

Select Case arr(1, index)
Case cdeEqual
Case cdeSourceDirOnly
copyDirection = 1
Case cdeDestDirOnly
copyDirection = 2
Case Else
If arr(1, index) = cdeAttributesDiffer Then
ElseIf (arr(1, index) And cdeDateDiffer) = cdeSourceIsOlder Then
copyDirection = 2
Else
copyDirection = 1
End If
End Select

If copyDirection = 1 Then
fso.CopyFile sourceDir & arr(0, index), destDir & arr(0, index), _
True
ElseIf copyDirection = 2 And TwoWaySync Then
fso.CopyFile destDir & arr(0, index), sourceDir & arr(0, index), _
True
End If
DoEvents
Next
End Sub

Private Sub cmdCopiar_Click()
If MsgBox("Este proceso tardará varios minutos en completarse!!" & vbNewLine _
& "Desea empezar la copia?", vbQuestion & vbYesNo) = vbYes Then
Dim I As Integer
DoEvents
Call SynchronizeDirectoryTrees(txtSource, txtDestination, False)
DoEvents
MsgBox "Proceso completado!!", vbInformation
End If
End Sub

[carnero]

no me copia nada, no se cahe pero no copia

[lokoman]

A mi me funciona de pelicula... te está dando algun error? le pusiste la referencia a Microsoft Scripting Runtime? le pusiste los nombres correctos a los textboxes (txtSource y txtDestination) y al command (cmdCopiar)? que ruta le estas pasando en el fuente y el destino? es posible que las rutas tengan algun problema...

[miguelajh]

El problema sería que la maquina tuviera un antivirus contra los autorun.inf y no te servirá de nada.

[carnero]

no me copia nada, prove con archivos y carpetas y nada y copio tal cual puse las referencias y no tira ningun error

[lokoman]

Ummm....... bajate el proyecto y ve si te corre, si no hace nada, es algo en tu pc.
http://myfreefilehosting.com/f/5b8a252aee_0.01MB