Discussion :

[anisr]

Bonjour à Tous

Avec ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub Transfert()
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim fs, f1, f2, f, fd
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f1 = fs.OpenTextFile("C:\final\consolidation.txt", ForWriting, , TristateUseDefault)
 
    specdossier = "c:\initial"
    Set fd = fs.GetFolder(specdossier)
 
    n = 1
    For Each f In fd.Files
        Set f2 = fs.OpenTextFile(specdossier & Application.PathSeparator & f.Name, ForReading, , TristateUseDefault)
        ' Ecrase tout dans le fichier consolidation.txt (ForWriting) donc garde la 1ere ligne du 1er fichier txt trouvé
        If n = 1 Then
            f1.Write f2.ReadAll
        Else       
            f2.SkipLine ' Ne prend pas en compte la 1ere ligne
            f1.Write f2.ReadAll
        End If
        f2.Close
        n = n + 1
    Next f
    f1.Close
    Set f = Nothing
    Set fd = Nothing
    Set f2 = Nothing
    Set f1 = Nothing
    Set fs = Nothing
End Sub

j'arrive à alimenter un fichier de synthèse situé dans un répertoir à partir de plusieurs fichiers situé dans un répertoir de départ.

Mon problème est devenu plus complexe, comment faire pour alimenter plusieurs fichiers à situer dans

C:\final

A partir de fichiers situés dans

C:\initial

sachant que chaque fichier de c:\initial ne doit alimenter q'un seul fichier de c:\final ayant le même nom.

[anisr]

Je crois qu'il faut tester sur le nom du fichier avant de commencer le processus d'ecriture.

[anisr]

Non, mon problème c'est de parcourir le repertoir initial et de copier tous les fichiers, fichier par fichier dans le répertoir final avec pour correspondance le nom de fichier.

Franchement je ne sais pas comment imbriquer ces deux routines

[dadavyvy]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub Transfert()
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim fs, f1, f2, f, fd
    Set fs = CreateObject("Scripting.FileSystemObject")
 
    dossierinit = "c:\initial"
    dossierfinal = "c:\final"
    Set fd = fs.GetFolder(specdossier)
 
    n = 1
    For Each f In fd.Files
        Set f2 = fs.OpenTextFile(dossierinit & Application.PathSeparator & f.Name, ForReading, , TristateUseDefault)
        ' Rajoute a la suite (ForAppending) car il n'y a pas d'interet a ecraser le fichier final, sinon une commande DOS est bcp plus simple
        Set f1 = fs.OpenTextFile(dossierfinal & Application.PathSeparator & f.Name, ForAppending, , TristateUseDefault)
        If Trim(f1.ReadLine) <> "" Then f2.SkipLine ' Ne prend pas en compte la 1ere ligne
        f1.Write f2.ReadAll
        f1.Close
        f2.Close
        n = n + 1
    Next f
    Set f = Nothing
    Set fd = Nothing
    Set f2 = Nothing
    Set f1 = Nothing
    Set fs = Nothing
End Sub

C'etait pourtant assez facile a adapter...

[anisr]

J'ai apporté quelques modif

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub Transfert()
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim fs, f1, f2, f, fd
    Set fs = CreateObject("Scripting.FileSystemObject")
 
    dossierinit = "c:\initial"
    dossierfinal = "c:\final"
    Set fd = fs.GetFolder(dossierinit)
 
    n = 1
    For Each f In fd.Files
        Set f2 = fs.OpenTextFile(dossierinit & Application.PathSeparator & f.Name, ForReading, , TristateUseDefault)
        ' Rajoute a la suite (ForAppending) car il n'y a pas d'interet a ecraser le fichier final, sinon une commande DOS est bcp plus simple
        Set f1 = fs.OpenTextFile(dossierfinal & Application.PathSeparator & f.Name, ForAppending, , TristateUseDefault)
        If Trim(f2.ReadLine) <> "" Then f2.SkipLine ' Ne prend pas en compte la 1ere ligne
        f1.Write f2.ReadAll
        f1.Close
        f2.Close
        n = n + 1
    Next f
    Set f = Nothing
    Set fd = Nothing
    Set f2 = Nothing
    Set f1 = Nothing
    Set fs = Nothing
End Sub

actuellement ça cmarche Merci