para Max

sebastian
25 de Noviembre del 2004
Hola Max, gracias por responder.....
Nesecitario un ejemplo porque no tengo ni idea como hacerlo, si tenes algo te lo agradeceria

Max
25 de Noviembre del 2004
Esta es la opcion para que le enlaces la progressbar que quieras.

Suerte !!

Function CopyFile(Src As String, Dst As String) As Single
Dim response As String
Static Buf$
Dim BTest!, FSize! 'Declaramos las variables que necesitamos
Dim Chunk%, F1%, F2%

Const BUFSIZE = 1024 'Establecemos el tamaño del buffer

If Len(Dir(Dst)) Then 'Comprobamos si el fichero de destino ya existe
response = MsgBox(Dst + Chr(10) + Chr(10) + "File already exists. Do you want to overwrite it?", vbYesNo + vbQuestion) 'prompt the user with a message box
If response = vbNo Then 'Si es pulsado el boton "NO"
Exit Function 'Salimos del procedimiento
Else 'De lo contrario
Kill Dst 'Borramos el fichero que existia, y seguimos con el codigo
End If
End If

On Error GoTo FileCopyError 'En caso de error vamos a esta etiqueta
F1 = FreeFile 'Devolvemos el numero de ficheros disponible
Open Src For Binary As F1 'Abrimos el fichero origen
F2 = FreeFile 'Devolvemos el numero de ficheros disponible
Open Dst For Binary As F2 'Abrimos el fichero de destino

FSize = LOF(F1)
BTest = FSize - LOF(F2)

Do
If BTest < BUFSIZE Then
Chunk = BTest
Else
Chunk = BUFSIZE
End If

Buf = String(Chunk, " ")
Get F1, , Buf
Put F2, , Buf
BTest = FSize - LOF(F2)

BarraProgreso.Value = (100 - Int(100 * BTest / FSize)) 'advance the progress bar as the file is copied

Loop Until BTest = 0
Close F1 'Cerramos el fichero origen
Close F2 'Cerramos el fichero destino
CopyFile = FSize
BarraProgreso.Value = 0 'Posicionamos la barra de progreso a 0
Exit Function 'Salimos del procedimiento

FileCopyError: 'Etiqueta de error
MsgBox "Error en la copia!, Intentelo otra vez..." 'Mostramos una cja de texto
Close F1 'Cerramos el fichero origen
Close F2 'Cerramos el fichero destino
Exit Function 'Salimos del procedimiento

End Function