MAJ fichiersRésolu

Question

Voila j'ai réussis grâces a des sources et à des cours
proposées sur developpez.com à fair une petite appli de maj de mes
dossiers.
Cependant j'ai un petit soucie sur un bout de code ne
m'appartenant pas en ce qui concerne sa personalisation. Je m'explique,
j'aimerai que les fichiers copié n'ailles pas dans le repertoires ciblé
mais dans un autres.

je présume que c'est évidement cette ligne à modifier     CopyFile FileTrouve, FileVerif, 0
mais malgrès mes efforts, et surement avec la fatigue cumulée de la journée j'avoue bloquer un petit peu. 
Surement du à une mal compréhension du code.

N'hésitez pas à me donner un coup de main ou à m'éclaircir les idées pour que je puisse me débrouiller seul.

Voici la fonction utilisant ma fonction ci-dessous

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

        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
                CopyFile FileTrouve, FileVerif, 0
            Else
                If FileDateTime(FileTrouve) > FileDateTime(FileVerif) Then
                    CopyFile FileTrouve, FileVerif, 0
                End If
            End If
            
            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

cs_casy · Accepted Answer

Visiblement le dossier de destination se trouve contenu dans la variable ValRep2.

Or ValRep2 n'est défini nulle part dans le code que tu donne, serait-ce une variable globale initialisée ailleurs ?

---- Sevyc64  (alias Casy) ----<hr size="2" width="100%" /># LE PARTAGE EST NOTRE FORCE #    http://aide-office-vba.monforum.com/index.php

fabricioliking · Answer

Oui en effet le var ValRep2 contiens bien l'adresse de destination du fichier, mais je n'arrive pas à copier l'ensemble de mon fichier un dans le nouveau dossier que si celui ci est identique à une date ultérieur de celui trouvé dans le second fichier. Cependant, si j'édite le contenue de la var valrep2 celui ci va copier l'ensemble du contenue de mon premier dossier dans celui ciblé
j'ai annulé la modification faite d'hier dans le code ci-dessous.
Je fait part de l'autre bout de monde code :

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

cs_casy · Answer

J'ai pas bien compris ton besoin, là.

Soit tu veux copier tous les fichiers dans un autre répertoire que celui défini jusqu'à maintenant. Dans ce cas, il te faut  regarder la façon dont est attribuer le chemin à la variable ValRep2 et modifier en conséquence.

Soit tu veux copier les fichiers dans le répertoire défini sauf quelqu'uns que tu veux copier ailleurs. Dans ce cas, ces fichiers là doivent bien répondre à une certaine condition.
Il te faut dans ce cas passer par une variable intermédaire dans ta fonction FindFile. Si ta condition est remplie ta variable contient le nouveau chemin, sinon elle contient le chemin contenu dans ValRep2

---- Sevyc64  (alias Casy) ----<hr size="2" width="100%" /># LE PARTAGE EST NOTRE FORCE #    http://aide-office-vba.monforum.com/index.php

MAJ fichiers

3 réponses

Votre réponse

Discussions similaires