Ejecutar comdandos de DOS desde Visual Basic
Hola, estoy creando una aplicación cuyo objetivo es realizar copias de respaldo de directorios en el disco duro, básicamente toma un path de origen, otro de destino y debe ejecutar la copia respectiva; el problema es que no se como indicarle a VB que copie los archivos de un lado a otro. Los path se almacenan en un campo de un base de datos; pensé en usar el comando DOS copy (copy por y)pero no se ni invocarlo y establecerle el valor de "x" y "y" (path).
Gracias!
Gracias!
1 respuesta
Respuesta de gonymon
1
Un ejemplo de sentencia con filecopy es
FileCopy "c:\AUTOEXEC.Bat", "c:\miscopias\autoexec.bat"
En tu caso sería:
Dim RutaOrigen as string
Dim RutaDestino as string
'Ahora meterías los valores que tengas almacenados en donde sea para estas variables
RutaOrigen="c:\Windows\"
RutaDestino="c:\Copias\"
Dim ficheroLeido As String
ficheroLeido = Dir("c:\")
Do While Trim(ficheroLeido) <> ""
Doevents 'Esto para que no parezca colgado
'Yo por aquí informaría al usuario de que fichero voy a copiar (poniendo el nombre en un label o algo así)
FileCopy RutaOrigen & FicheroLeido, RutaDestino & FicheroLeido
ficheroLeido = Dir()
Loop
Lo de seleccionar los path... eso puede volverse un poco más complicado. Supongo que te refieres a haber usado el DirListBox (el filelist no muestra carpetas... al menos el que yo tengo instalado)
Si me mandas el código que has usado para almacenar un solo path te busco una solución sencilla para varios path siguiente tu esquema de programación.
FileCopy "c:\AUTOEXEC.Bat", "c:\miscopias\autoexec.bat"
En tu caso sería:
Dim RutaOrigen as string
Dim RutaDestino as string
'Ahora meterías los valores que tengas almacenados en donde sea para estas variables
RutaOrigen="c:\Windows\"
RutaDestino="c:\Copias\"
Dim ficheroLeido As String
ficheroLeido = Dir("c:\")
Do While Trim(ficheroLeido) <> ""
Doevents 'Esto para que no parezca colgado
'Yo por aquí informaría al usuario de que fichero voy a copiar (poniendo el nombre en un label o algo así)
FileCopy RutaOrigen & FicheroLeido, RutaDestino & FicheroLeido
ficheroLeido = Dir()
Loop
Lo de seleccionar los path... eso puede volverse un poco más complicado. Supongo que te refieres a haber usado el DirListBox (el filelist no muestra carpetas... al menos el que yo tengo instalado)
Si me mandas el código que has usado para almacenar un solo path te busco una solución sencilla para varios path siguiente tu esquema de programación.
Gracias por tu ayuda, no me queda claro qué realiza la instrucción ficheroLeido=Dir("c:\")
y
ficheroLeido=Dir()
Todo lo demás me quedo super claro! Ahorita no tengo el código en esta pc, voy a sacarlo de la otra y te lo hago llegar por este medio, para que si no es mucha la molestia, lo revises y me aconsejes como seleccionar múltiples archivos!
Muchas gracias!
y
ficheroLeido=Dir()
Todo lo demás me quedo super claro! Ahorita no tengo el código en esta pc, voy a sacarlo de la otra y te lo hago llegar por este medio, para que si no es mucha la molestia, lo revises y me aconsejes como seleccionar múltiples archivos!
Muchas gracias!
Tienes varias soluciones, desde las "mejores" usando dll's hasta las "fáciles" usando comandos del VB para copiar ficheros FileCopy para copiar ficheros y DIR para saber que ficheros copiar.
Gracias, me podrías explicar como montar una sentencia con FileCopy, yo tengo almacenado el path de origen y el de destino en un campo de una base de datos cada uno!
Otra pregunta, para seleccionar los path yo utilice el filelist, ¿pero no logro que se puedan seleccionar varios archivos a la vez...?
Gracias por tu tiempo!.
Otra pregunta, para seleccionar los path yo utilice el filelist, ¿pero no logro que se puedan seleccionar varios archivos a la vez...?
Gracias por tu tiempo!.
Hola, a continuación te ajunto el código de mi aplicación para seleccionar las rutas de los archivos...
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub dir1_Click()
If Option1(0) = True Then
rutaorigen(0).Text = Dir1.Path
archivo = ""
'archivo=dir1.Path & "\" & *.*
Else
If Option1(1) = True Then
rutaorigen(2).Text = Dir1.Path & "\" & archivo
Else
MsgBox "Debe seleccionar si desea establecer la ruta de origen o de destino"
End If
End If
End Sub
Private Sub file1_click()
If Option1(0) = True Then
rutaorigen(0).Text = File1.Path & "\" & File1.FileName
'rutaorigen(0).Text = File1.Path & "\" & File1.MultiSelect
'rutaorigen(0).Text = File1.Path & "\" & File1.Selected
archivo = File1.FileName
'MsgBox archivo
Else
If Option1(1) = True Then
'rutaorigen(2).Text = File1.Path & "\" & File1.FileName ' & "\" & archivo
rutaorigen(2).Text = Dir1.Path & "\" & archivo
MsgBox "No se puede copiar archivos dentro de archivos, solo dentro de directorios!"
Else
MsgBox "Debe seleccionar si desea establecer la ruta de origen o de destino"
End If
End If
End Sub
Muchas gracias!
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub dir1_Click()
If Option1(0) = True Then
rutaorigen(0).Text = Dir1.Path
archivo = ""
'archivo=dir1.Path & "\" & *.*
Else
If Option1(1) = True Then
rutaorigen(2).Text = Dir1.Path & "\" & archivo
Else
MsgBox "Debe seleccionar si desea establecer la ruta de origen o de destino"
End If
End If
End Sub
Private Sub file1_click()
If Option1(0) = True Then
rutaorigen(0).Text = File1.Path & "\" & File1.FileName
'rutaorigen(0).Text = File1.Path & "\" & File1.MultiSelect
'rutaorigen(0).Text = File1.Path & "\" & File1.Selected
archivo = File1.FileName
'MsgBox archivo
Else
If Option1(1) = True Then
'rutaorigen(2).Text = File1.Path & "\" & File1.FileName ' & "\" & archivo
rutaorigen(2).Text = Dir1.Path & "\" & archivo
MsgBox "No se puede copiar archivos dentro de archivos, solo dentro de directorios!"
Else
MsgBox "Debe seleccionar si desea establecer la ruta de origen o de destino"
End If
End If
End Sub
Muchas gracias!
Aquí te mando el código, pero si me pones un correo te mando el proyecto completo. Será más fácil y didáctico ya que verás el funcionamiento.
Option Explicit
Dim Romper As Boolean
Dim Procesando As Boolean
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Procesando Then
Cancel = True
If MsgBox("Está procesando información. ¿Desea detener el proceso?", vbYesNoCancel + vbDefaultButton3 + vbQuestion) <> vbYes Then Exit Sub
Procesando = False
Romper = True
End If
End Sub
Private Sub btnAceptar_Click()
Dim origen As String
Dim destino As String
Dim Agregado As String
'Primero Validamos
origen = Trim(Me.DirOri.Path)
destino = Trim(Me.DirDestino.Path)
If UCase(origen) = UCase(destino) Then
MsgBox "Destino y origen deben ser distintos", vbInformation
Exit Sub
End If
'Usamos un separador no válido como nombre de carpeta para separar el origen del destino
Agregado = origen & "?" & destino
'Validamos que no ha añadido esa configuración con anterioridad
If existeconfiguracion(Agregado) Then
MsgBox "Esa ruta ya está agregada", vbInformation
Exit Sub
End If
Me.ListConfigurado.AddItem Agregado
End Sub
Private Function existeconfiguracion(ByVal laconfiguracion As String) As Boolean
Dim buc As Integer
existeconfiguracion = False
For buc = 0 To Me.ListConfigurado.ListCount - 1
If UCase(laconfiguracion) = UCase(Me.ListConfigurado.List(buc)) Then
existeconfiguracion = True
Exit For
End If
Next buc
End Function
Private Sub btnQuitar_Click()
Dim buc As Integer
If Me.ListConfigurado.SelCount = 0 Then
MsgBox "Debe seleccionar algo a quitar (del list ya configurado)", vbInformation
Exit Sub
End If
For buc = 0 To Me.ListConfigurado.ListCount - 1
If Me.ListConfigurado.Selected(buc) Then
Me.ListConfigurado.RemoveItem buc
Exit For
End If
Next buc
' Me.ListConfigurado.RemoveItem Me.ListConfigurado.Selected
End Sub
Private Sub DirOri_Change()
Me.FileOri.Path = Me.DirOri.Path
End Sub
Private Sub DriveDestino_Change()
On Error GoTo Err_Local
Me.DirDestino.Path = Me.DriveDestino.Drive
On Error GoTo 0
Exit Sub
Err_Local:
MsgBox "Ha ocurrido un error al cambiar la unidad. Nº Error:" & Err.Number & vbCrLf & Err.Description, vbCritical
On Error GoTo 0
Exit Sub
End Sub
Private Sub DriveOri_Change()
On Error GoTo Err_Local
Me.DirOri.Path = Me.DriveOri.Drive
On Error GoTo 0
Exit Sub
Err_Local:
MsgBox "Ha ocurrido un error al cambiar la unidad. Nº Error:" & Err.Number & vbCrLf & Err.Description, vbCritical
On Error GoTo 0
Exit Sub
End Sub
Private Sub Form_Load()
Me.ListConfigurado.Clear
Romper = False
Procesando = False
End Sub
Private Sub btnCopiar_Click()
If Me.ListConfigurado.ListCount <= 0 Then
MsgBox "No se ha configurado nada para copiar", vbInformation
Exit Sub
End If
btnCopiar.Enabled = False
HazCopia
btnCopiar.Enabled = True
End Sub
Private Sub get_config(ByVal configuracion As String, ByRef vorigen As String, ByRef vdestino As String)
Dim posi As Long
posi = InStr(1, configuracion, "?")
vorigen = Mid(configuracion, 1, posi - 1)
vdestino = Mid(configuracion, posi + 1)
End Sub
Private Sub HazCopia()
On Error GoTo Err_Local
Dim origen As String
Dim destino As String
Dim paso As Integer
Procesando = True
Romper = False
For paso = 0 To Me.ListConfigurado.ListCount - 1
get_config Me.ListConfigurado.List(paso), origen, destino
Me.LabelInformacion.Caption = "Copiando paso " & paso & " de " & Me.ListConfigurado.ListCount - 1
DoEvents
If Romper Then Exit For 'Esta es una salida permitida al usuario
CopiarFicheros origen, destino
Next paso
Me.LabelInformacion.Caption = ""
On Error GoTo 0
If Romper Then
MsgBox "Proceso Erroneo o detenido por el usuario", vbExclamation
Else
MsgBox "Proceso concluido", vbInformation
End If
Procesando = False
Exit Sub
Err_Local:
If MsgBox("Ha ocurrido un error al copiar." & vbCrLf & _
"Nº Error:" & Err.Number & vbCrLf & _
Err.Description & vbCrLf & _
Err.Source & vbCrLf & _
"¿ Continuar ?", vbYesNo + vbDefaultButton1 + vbCritical) = vbYes Then
Resume Next 'Continuamos en la siguiente instrucción
End If
On Error GoTo 0
Me.LabelInformacion.Caption = "Ha fallado la copia"
Procesando = False
Exit Sub
End Sub
Private Sub CopiarFicheros(ByVal origen As String, ByVal destino As String)
Dim FicLeido As String
On Error GoTo Err_Local
FicLeido = Dir(origen & "\*.*")
Do While Trim(FicLeido) <> ""
Me.LabelInformacion.Caption = "Copiando fichero:" & origen & "\" & FicLeido
DoEvents
If Romper Then Exit Do
FileCopy origen & "\" & FicLeido, destino & "\" & FicLeido
FicLeido = Dir()
Loop
Me.LabelInformacion.Caption = "Finalizada copia de " + origen
On Error GoTo 0
Exit Sub
Err_Local:
If MsgBox("Ha ocurrido un error en (copiarficheros)." & vbCrLf & _
"Nº Error:" & Err.Number & vbCrLf & _
Err.Description & vbCrLf & _
Err.Source & vbCrLf & _
"¿ Continuar ?", vbYesNo + vbDefaultButton1 + vbCritical) = vbYes Then
Resume Next 'Continuamos en la siguiente instrucción
End If
On Error GoTo 0
Me.LabelInformacion.Caption = "Ha fallado la copia"
Procesando = False
Romper = True 'para que salga de los bucles
Exit Sub
End Sub
Option Explicit
Dim Romper As Boolean
Dim Procesando As Boolean
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Procesando Then
Cancel = True
If MsgBox("Está procesando información. ¿Desea detener el proceso?", vbYesNoCancel + vbDefaultButton3 + vbQuestion) <> vbYes Then Exit Sub
Procesando = False
Romper = True
End If
End Sub
Private Sub btnAceptar_Click()
Dim origen As String
Dim destino As String
Dim Agregado As String
'Primero Validamos
origen = Trim(Me.DirOri.Path)
destino = Trim(Me.DirDestino.Path)
If UCase(origen) = UCase(destino) Then
MsgBox "Destino y origen deben ser distintos", vbInformation
Exit Sub
End If
'Usamos un separador no válido como nombre de carpeta para separar el origen del destino
Agregado = origen & "?" & destino
'Validamos que no ha añadido esa configuración con anterioridad
If existeconfiguracion(Agregado) Then
MsgBox "Esa ruta ya está agregada", vbInformation
Exit Sub
End If
Me.ListConfigurado.AddItem Agregado
End Sub
Private Function existeconfiguracion(ByVal laconfiguracion As String) As Boolean
Dim buc As Integer
existeconfiguracion = False
For buc = 0 To Me.ListConfigurado.ListCount - 1
If UCase(laconfiguracion) = UCase(Me.ListConfigurado.List(buc)) Then
existeconfiguracion = True
Exit For
End If
Next buc
End Function
Private Sub btnQuitar_Click()
Dim buc As Integer
If Me.ListConfigurado.SelCount = 0 Then
MsgBox "Debe seleccionar algo a quitar (del list ya configurado)", vbInformation
Exit Sub
End If
For buc = 0 To Me.ListConfigurado.ListCount - 1
If Me.ListConfigurado.Selected(buc) Then
Me.ListConfigurado.RemoveItem buc
Exit For
End If
Next buc
' Me.ListConfigurado.RemoveItem Me.ListConfigurado.Selected
End Sub
Private Sub DirOri_Change()
Me.FileOri.Path = Me.DirOri.Path
End Sub
Private Sub DriveDestino_Change()
On Error GoTo Err_Local
Me.DirDestino.Path = Me.DriveDestino.Drive
On Error GoTo 0
Exit Sub
Err_Local:
MsgBox "Ha ocurrido un error al cambiar la unidad. Nº Error:" & Err.Number & vbCrLf & Err.Description, vbCritical
On Error GoTo 0
Exit Sub
End Sub
Private Sub DriveOri_Change()
On Error GoTo Err_Local
Me.DirOri.Path = Me.DriveOri.Drive
On Error GoTo 0
Exit Sub
Err_Local:
MsgBox "Ha ocurrido un error al cambiar la unidad. Nº Error:" & Err.Number & vbCrLf & Err.Description, vbCritical
On Error GoTo 0
Exit Sub
End Sub
Private Sub Form_Load()
Me.ListConfigurado.Clear
Romper = False
Procesando = False
End Sub
Private Sub btnCopiar_Click()
If Me.ListConfigurado.ListCount <= 0 Then
MsgBox "No se ha configurado nada para copiar", vbInformation
Exit Sub
End If
btnCopiar.Enabled = False
HazCopia
btnCopiar.Enabled = True
End Sub
Private Sub get_config(ByVal configuracion As String, ByRef vorigen As String, ByRef vdestino As String)
Dim posi As Long
posi = InStr(1, configuracion, "?")
vorigen = Mid(configuracion, 1, posi - 1)
vdestino = Mid(configuracion, posi + 1)
End Sub
Private Sub HazCopia()
On Error GoTo Err_Local
Dim origen As String
Dim destino As String
Dim paso As Integer
Procesando = True
Romper = False
For paso = 0 To Me.ListConfigurado.ListCount - 1
get_config Me.ListConfigurado.List(paso), origen, destino
Me.LabelInformacion.Caption = "Copiando paso " & paso & " de " & Me.ListConfigurado.ListCount - 1
DoEvents
If Romper Then Exit For 'Esta es una salida permitida al usuario
CopiarFicheros origen, destino
Next paso
Me.LabelInformacion.Caption = ""
On Error GoTo 0
If Romper Then
MsgBox "Proceso Erroneo o detenido por el usuario", vbExclamation
Else
MsgBox "Proceso concluido", vbInformation
End If
Procesando = False
Exit Sub
Err_Local:
If MsgBox("Ha ocurrido un error al copiar." & vbCrLf & _
"Nº Error:" & Err.Number & vbCrLf & _
Err.Description & vbCrLf & _
Err.Source & vbCrLf & _
"¿ Continuar ?", vbYesNo + vbDefaultButton1 + vbCritical) = vbYes Then
Resume Next 'Continuamos en la siguiente instrucción
End If
On Error GoTo 0
Me.LabelInformacion.Caption = "Ha fallado la copia"
Procesando = False
Exit Sub
End Sub
Private Sub CopiarFicheros(ByVal origen As String, ByVal destino As String)
Dim FicLeido As String
On Error GoTo Err_Local
FicLeido = Dir(origen & "\*.*")
Do While Trim(FicLeido) <> ""
Me.LabelInformacion.Caption = "Copiando fichero:" & origen & "\" & FicLeido
DoEvents
If Romper Then Exit Do
FileCopy origen & "\" & FicLeido, destino & "\" & FicLeido
FicLeido = Dir()
Loop
Me.LabelInformacion.Caption = "Finalizada copia de " + origen
On Error GoTo 0
Exit Sub
Err_Local:
If MsgBox("Ha ocurrido un error en (copiarficheros)." & vbCrLf & _
"Nº Error:" & Err.Number & vbCrLf & _
Err.Description & vbCrLf & _
Err.Source & vbCrLf & _
"¿ Continuar ?", vbYesNo + vbDefaultButton1 + vbCritical) = vbYes Then
Resume Next 'Continuamos en la siguiente instrucción
End If
On Error GoTo 0
Me.LabelInformacion.Caption = "Ha fallado la copia"
Procesando = False
Romper = True 'para que salga de los bucles
Exit Sub
End Sub
