Uso de SHFileOperation VB6.0

[joselete666]

Hola pkj lo del control de errores ya lo puse pero no coge nada. Te pongoel codigo que tengo. Hay que decir que tengo muchos checkbox y que la mayoria son de nombres de pc y los demas opciones.

Option Explicit

' Variables para el programa de prueba
Private sFicOri As String
Private sFicDes As String
Private iFlags As Long
' Constantes para el orden de los chkOpciones
Private Enum eOpciones
cFOF_ALLOWUNDO
cFOF_FILESONLY
cFOF_MULTIDESTFILES
cFOF_NOCONFIRMATION
cFOF_NOCONFIRMMKDIR
cFOF_RENAMEONCOLLISION
cFOF_SILENT
cFOF_SIMPLEPROGRESS
cFOF_NOERRORUI
End Enum

' Variables, constantes y declaraciones para el API
Private Type SHFILEOPSTRUCT
hWnd As Long ' hWnd del formulario
wFunc As Long ' Función a usar: FO_COPY, etc.
pFrom As String ' Fichero(s) de origen
pTo As String ' Fichero(s) de destino
' fFlags para Windows 2000/XP declararlo como Long
' para Windows 9x declararlo como Integer,
' aunque también funciona si se declara como Long (al menos en W98)
'fFlags As Integer ' Opciones
fFlags As Long
fAnyOperationsAborted As Boolean ' Si se ha cancelado
hNameMappings As Long '
lpszProgressTitle As String ' Sólo si se usa FOF_SIMPLEPROGRESS
End Type

' Constantes para FileOperation
Private Enum eFO
FO_COPY = &H2& ' Copiar
FO_DELETE = &H3& ' Borrar
FO_MOVE = &H1& ' Mover
FO_RENAME = &H4& ' Renombrar
'
FOF_MULTIDESTFILES = &H1& ' Multiples archivos de destino
FOF_CONFIRMMOUSE = &H2& ' No está implementada
FOF_SILENT = &H4& ' No mostrar el progreso
FOF_RENAMEONCOLLISION = &H8& ' Cambiar el nombre si el archivo de destino ya existe
FOF_NOCONFIRMATION = &H10& ' No pedir confirmación
FOF_WANTMAPPINGHANDLE = &H20& '// Fill in SHFILEOPSTRUCT.hNameMappings
'// Must be freed using SHFreeNameMappings
FOF_ALLOWUNDO = &H40& ' Permitir deshacer
FOF_FILESONLY = &H80& ' Si se especifica *.*, hacerlo sólo con archivos
FOF_SIMPLEPROGRESS = &H100& ' No mostrar los nombres de los archivos
FOF_NOCONFIRMMKDIR = &H200& ' No confirmar la creación de directorios
FOF_NOERRORUI = &H400& '// don't put up error UI
FOF_NOCOPYSECURITYATTRIBS = &H800& '// don't copy NT file Security Attributes
End Enum

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long


Dim varArray() As String
Dim iContador As Integer



Private Sub cmdCopiar_Click()
List1.Clear
List2.Clear
List3.Clear

Dim xctl As Control

iContador = 0


' Bucle sobre los controles contenidos en el formulario
For Each xctl In Me.Controls
Select Case UCase(TypeName(xctl))
Case "CHECKBOX"


If Left(xctl.Name, 5) <> "chkOp" And _
xctl.Enabled And _
xctl.Value = 1 Then

List1.AddItem xctl.Name

iContador = iContador + 1

ReDim Preserve varArray(iContador - 1)
varArray(iContador - 1) = xctl.Name



End If

End Select
Next



' Copiar
Dim SHFileOp As SHFILEOPSTRUCT
Dim i As Integer
' Asignar el valor de las opciones
AsignarFlags
MsgBox (iContador)
For i = 0 To iContador - 1
sFicOri = txtOri & vbNullChar & vbNullChar
sFicDes = "\\" & varArray(i) & txtDes & vbNullChar & vbNullChar
MsgBox (sFicDes)
MsgBox (i)

With SHFileOp
.wFunc = FO_COPY
.fFlags = iFlags
.hWnd = Me.hWnd
.pFrom = sFicOri
.pTo = sFicDes
.lpszProgressTitle = "Copiando los ficheros especificados"
End With

Call SHFileOperation(SHFileOp)
List2.AddItem varArray(i)
List1.RemoveItem 0

Next i

Exit Sub


End Sub




Private Sub Form_Load()
Dim i As Long

sFicOri = App.Path & "\Prueba.txt"
sFicDes = App.Path & "\Temporal\Prueba.txt"



txtOri = sFicOri
txtDes = sFicDes

Crear el fichero de prueba.txt
i = FreeFile
Open sFicOri For Output As i
Print #i, "Fichero de prueba"
Close

End Sub

Private Sub AsignarFlags()
' Ajusta el valor del flag, según las opciones seleccionadas
iFlags = 0
If chkOpciones(cFOF_ALLOWUNDO) Then _
iFlags = iFlags + FOF_ALLOWUNDO

If chkOpciones(cFOF_FILESONLY) Then _
iFlags = iFlags + FOF_FILESONLY

If chkOpciones(cFOF_MULTIDESTFILES) Then _
iFlags = iFlags + FOF_MULTIDESTFILES

If chkOpciones(cFOF_NOCONFIRMATION) Then _
iFlags = iFlags + FOF_NOCONFIRMATION

If chkOpciones(cFOF_NOCONFIRMMKDIR) Then _
iFlags = iFlags + FOF_NOCONFIRMMKDIR

If chkOpciones(cFOF_RENAMEONCOLLISION) Then _
iFlags = iFlags + FOF_RENAMEONCOLLISION

If chkOpciones(cFOF_SILENT) Then _
iFlags = iFlags + FOF_SILENT

If chkOpciones(cFOF_SIMPLEPROGRESS) Then _
iFlags = iFlags + FOF_SIMPLEPROGRESS
If chkOpciones(cFOF_NOERRORUI) Then _
iFlags = iFlags + FOF_NOERRORUI

End Sub




Bueno ese es el codigo que tengo. Decir que todabia lo tengo en pruebas y vereis cosas raras y tambien decir que no no se mucho del tema ya que soy un principiante y he ido cogiendo codigo que me he ido encontrando y adecuando a mis necesidades.

Muchas gracias.