Copie de fichier

Résolu
Signaler
Messages postés
79
Date d'inscription
mercredi 30 août 2006
Statut
Membre
Dernière intervention
15 mai 2009
-
Messages postés
14832
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
5 décembre 2021
-
J'ai un petit soucie avec mon code, en effet je l'ai battis grâce à des
sources et des cours sur vbfrance et developpez.com et j'ai surement
mal compris un bout de code ce qui me blok dans mon développement.

En effet j'aimerai pouvoir copier l'ensemble d'un fichier dans un autre
que ci ce fichier est présent dans un autre (lors de la comparaison) et
que ce fichier est plus récent. Si c'est le cas je voudrais copier
l'ensemble des dossiers et sous dossiers


Je vous propose le code avec lequelle je suis en train de me débattre ^^.

N'hésitez pas à critiquer le tout ou à me fair part d'informations


Dim fso As New FileSystemObject

Dim fld As Folder

Dim Etape As Byte

Dim v As Boolean


Private Sub Command1_Click()


Dim Flag As Byte


On Error GoTo GestErreur


' *** CHOIX DES REPERTOIRES A COMPARER ***


Flag = 0


CHOIXREP:


If Flag = 0 Then

szTitle = "Selectionner le répertoire à comparer :"

ElseIf Flag = 1 Then

szTitle = "Selectionner le répertoire à mettre à jour :"

Else

GoTo Exit_Sub

End If


With tBrowseInfo

.hWndOwner = Me.hWnd

.lpszTitle = lstrcat(szTitle, "")

.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN

End With


lpIDList = SHBrowseForFolder(tBrowseInfo)


If (lpIDList) Then

sBuffer = Space(MAX_PATH)

SHGetPathFromIDList lpIDList, sBuffer

sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)

If Flag = 0 Then

ValRep1 = sBuffer

If DirectoryExist(ValRep1) = True Then

Flag = 1

GoTo CHOIXREP

Else

MsgBox "Répertoire incorrect !", vbCritical, "recommencez"

GoTo Exit_Sub

End If

ElseIf Flag = 1 Then

ValRep2 = sBuffer

If DirectoryExist(ValRep2) = False Then

MsgBox "Répertoire incorrect !", vbCritical, "recommencez"

GoTo Exit_Sub

End If

End If

End If


If MsgBox("Voulez-vous mettre à jour le répertoire " & ValRep2
& " avec " & ValRep1 & " ?", vbInformation + vbYesNo,
"Question") = vbNo Then Exit Sub


MousePointer = 11


FindFile ValRep1, "*.*"


MousePointer = 0


MsgBox "Mise à jour terminée !", vbInformation, "Fin"


Exit_Sub:

MousePointer = 0

Exit Sub


GestErreur:

MsgBox Err.Description, vbExclamation, Err

Resume Exit_Sub


End Sub


Function FindFile(ByVal sFol As String, sFile As String)


Dim tFld As Folder

Dim FileName As String

Dim FileVerif As String

Dim FileTrouve As String

Dim Pos As Long

Dim k As Integer

Dim j As Integer

j = 0

k = 0

Set fld = fso.GetFolder(sFol)


FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or vbHidden Or vbSystem Or vbReadOnly)


While Len(FileName) <> 0


FileTrouve = fso.BuildPath(fld.Path, FileName)


Pos = Len(ValRep1)


FileVerif = ValRep2 & Right(FileTrouve, Len(FileTrouve) - Pos)


If FileExist(FileVerif) = False Then


Else

If FileDateTime(FileTrouve) > FileDateTime(FileVerif) Then

CopyFile FileTrouve, FileVerif, 0

List1.AddItem FileVerif, k

k = k + 1

End If

End If

CopyFile FileTrouve, FileVerif, 0

List2.AddItem FileTrouve, j

j = j + 1

FileName = Dir() ' Get next file

DoEvents


Wend


If fld.SubFolders.Count > 0 Then

For Each tFld In fld.SubFolders

Pos = Len(ValRep1)

If DirectoryExist(ValRep2 & Right(tFld, Len(tFld) - Pos)) = False Then

MkDir ValRep2 & Right(tFld, Len(tFld) - Pos)

End If

DoEvents

FindFile = FindFile + FindFile(tFld.Path, sFile)

Next

End If


End Function

3 réponses

Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
58
Salut,
à défaut d'avoir une solution je vais critiquer

perso pour les valeurs de MousePointer j'utiliserais les membres de l'énumération MousePointerConstantVbHourGlass et VbDefault, juste pour plus de lisibilité.

Dans la procédure FindFile tu as cette condition If FileExist(FileVerif) = False Then
Si elle se rempli tu ne fait RIEN sinon tu fais QQCH

Met la condition inverse c'est plus "joli"

       If FileExist(FileVerif) Then
           If FileDateTime(FileTrouve) > FileDateTime(FileVerif) Then
               CopyFile FileTrouve, FileVerif, 0
               List1.AddItem FileVerif, k
               k = k + 1
           End If
       End If , ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée
Messages postés
79
Date d'inscription
mercredi 30 août 2006
Statut
Membre
Dernière intervention
15 mai 2009

Merci pour la critique, je vais tâcher de modifier le tout, cela ne peut qu'éclaircir mon projet.
Messages postés
14832
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
5 décembre 2021
157
Bonjour

Je rajoute : Erreur de thème :
[infomsg.aspx Thèmes] / [infomsgf_VB-NET-VB-2005_40.aspx VB.NET et VB 2005]
Au lieu de VB6.

Le fer à souder a besoin d'une panne pour fonctionner.
VB (6, .NET1&2), C++, C#.Net1
Mon site