Bonjour,
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"
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)
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