Utilisation d'un formulaire de copie de fichier 

wpe2.gif (1107 octets)exemple.mdb

Création du formulaire "FrmCopieFichier"

Contrôles :

  • Image1 : Image (disquette)
  • Image2 : Image (disquette)
  • ProgressBar : Progressbar (contrôle ActiveX)
  • Pourcent : Label

Ajouter la fonction suivante au code du formulaire :

Public Function CopieFichier(FichierOrigine As String, FichierDestination As String, OverWrite As Integer)
Dim Longueur, i, Increment, Reste, Octet, Maxi As Long
Dim Cpt As Byte
Dim Tampon(1024) As Byte

On Error GoTo Err_CopieFichier
Me.Repaint
If Len(Dir(FichierOrigine)) = 0 Then
CopieFichier = False
Exit Function
End If

If Len(Dir(FichierDestination)) <> 0 Then
If Not OverWrite Then
CopieFichier = False
Exit Function
End If
End If

Open FichierOrigine For Binary Access Read Lock Read Write As #1

Open FichierDestination For Binary Access Write As #2

Longueur = LOF(1)

Increment = (Longueur \ 1024)
Reste = (Longueur Mod 1024)

Me!ProgressBar.Min = 0
Maxi = Increment + Reste
Me!ProgressBar.Max = Maxi

For i = 0 To Increment
If Cpt = 50 Then
Image2.Visible = Not Image2.Visible
Image1.Visible = Not Image1.Visible
Me!Pourcent.Caption = Int(i / Maxi * 100) & "%"
Me.Repaint
Cpt = 0
End If
Cpt = Cpt + 1
Get #1, , Tampon
Put #2, , Tampon
Me!ProgressBar.Value = i

Next i

For i = 0 To Reste
Get #1, , Octet
Put #2, , Octet
Me!ProgressBar.Value = Me!ProgressBar.Value + i
Next i
Me!Pourcent.Caption = Int(i / Maxi * 100) & "%"
Me.Repaint
Close #1
Close #2
CopieFichier = True
Exit Function
Err_CopieFichier:
CopieFichier = False
Close #1
Close #2
Kill FichierDestination
Exit Function
End Function

Création du formulaire "FrmTestCopie"

Contrôles :

  • CmdCopier : Bouton
  • Origine : TextBox
  • Destination : TextBox
  • OverWrite : CheckBox

Associer le code suivant à l'événement "Click" du bouton "CmdCopier" :

Private Sub CmdCopier_Click()
Dim Origine As String, Destination As String
Dim OverWrite As Integer

On Error GoTo err_cmdcopier
Origine = Me!Origine
Destination = Me!Destination
OverWrite = Me!OverWrite
Dim f As New Form_FrmCopieFichier
f.Visible = True
resultat = f.CopieFichier(Origine, Destination, OverWrite)
If resultat Then
MsgBox "Copie terminée", vbInformation, "Information"
Else
MsgBox "Erreur lors de la copie", vbCritical, "Attention"
End If
Set f = Nothing

Exit Sub

err_cmdcopier:
MsgBox "Une erreur est survenue lors de la copie.", vbCritical, "Attention"
End Sub

Tester la copie en ouvrant le formulaire "FrmTestCopie" , spécifier le fichier d'origine et de destination et cliquer sur le bouton "Copier".