Copie de fichierRésolu

Question

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

jrivet · Accepted Answer

Salut,
à défaut d'avoir une solution je vais critiquer 

perso pour les valeurs de MousePointer j'utiliserais les membres de l'énumération MousePointerConstant:  VbHourGlass 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

fabricioliking · Answer

Merci pour la critique, je vais tâcher de modifier le tout, cela ne peut qu'éclaircir mon projet.

NHenry · Answer

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

Copie de fichier

3 réponses

Votre réponse

Discussions similaires