Discussion :

[vibos]

Bonjour,

-J’ai un tableau excel ou la colonne « IS » contient un numéro.
-Un Dossier ("C:\depart" par exemple) dans lequel il y a des sous-dossiers contenant des fichiers nommé xxxxxxxx-fiche.pdf (xxxxxx étant le numéro de ma colonne « IS »).

Je voudrais une macro qui prend les numéros de la colonne « IS » puis recherche les fichiers xxxxxx-fiche.pdf correspondant pour enfin les copier dans un autre dossier ("C:\arriver" par exemple).

Si je ne suis pas clair n’hésitez pas à poser des questions.

Merci.

PS: cette discussion est très proche mais je n'arrive pas a modifier le code.

[LeForestier]

Bonjour,
Regarde ce poste je pense que tu auras plus facile à l'adapter.
A+

[garion28]

http://www.info-3000.com/vbvba/recherchefichier.php
quasiment la même chose avec plus d'explication

[vibos]

Merci de vos réponses je regarde ça et je reviens si j’ai du mal

[vibos]

Bonjour,

Je pense n'être pas loin de la solution mais je bloque sur la copie.

J'ai concaténer dans la colonne JG le numéro et "-fiche.pdf", j'ai donc le nom complet du fichier dans cette colonne.

voici le 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
LireRepertoir2()
'lire les fichiers d'un répertoir
Dim fs, F, f1, S, sf
Dim Ext As String, Chemin As String
Dim i As Integer
Dim x As String
    Chemin = "\\machin\truc\bidule chose" 'adapter au répertoir où sont situés les fichiers.
    Ext = "pdf"
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    For Each f1 In sf
        If Right(f1.Name, 3) = Ext Then 'pour être certain que c'est un bon fichier
            'ici tester le nom
             For i = 1 To 1700
                If f1.Name = Cells(i, 240) Then
             'et en faire ce que l'ont veux
                 FileCopy ( Chemin & "\" & f1.name , "C:\Documents and Settings\moi\Mes documents\test2" )
             End If
        End If
    Next
End Sub

Merci de votre aide.

[LeForestier]

Donne un exemple "réel" et complet du nom du fichier.

[vibos]

Bonjour LeForestier,

voici les exemples de noms :
1641801-fiche.pdf
3622401-fiche.pdf
517801-fiche.pdf

Les noms sont dans la colonne JG, je veux les rechercher dans le dossier et les sous-dossiers pour les coller dans un autre dossier.(Il y a 1600 et quelque pdf à copier ).

j'espère être clair

Merci.

[LeForestier]

met un point d'arrèt sur Filecopy, ou si tu ne sais pas met Stop juste au dessus pour voir si le nom est trouver

Code :

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

1
2
3
4
5
               If f1.Name = Cells(i, 240) Then
             'et en faire ce que l'ont veux
              Stop
                 FileCopy ( Chemin & "\" & f1.name , "C:\Documents and Settings\moi\Mes documents\test2" )
             End If

Comme ça tu verras déjà si le nom est trouver

[vibos]

La macro ne compile pas car il y a une erreur de syntaxe sur cette ligne.

Code :

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

 FileCopy ( Chemin & "\" & f1.name , "C:\Documents and Settings\moi\Mes documents\test2" )

L'erreur apparait avec ou sans le stop, désolé j'aurais du le dire avant.

Merci de ton aide.

[LeForestier]

faut pas de parenthèse
tu dis

[vibos]

bonjour LeForestier,

j'avais oublier un Next
La macro marche mais ne trouve rien
Elle ne passe pas le texte de l'extension pdf.
Je pense qu'elle ne cherche pas dans les sous-dossiers.
Je retourne en croisade contre le VBA .

Merci de ton aide

[Krovax]

Code :

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

1
2
3
4
5
6
7
8
        If Right(f1.Name, 3) = Ext Then 'pour être certain que c'est un bon fichier
            'ici tester le nom
             For i = 1 To 1700
                   If f1.Name = Cells(i, 240) Then
             'et en faire ce que l'ont veux
                        FileCopy ( Chemin & "\" & f1.name , "C:\Documents and Settings\moi\Mes documents\test2" )
              End If
        End If

Il te manque un next i entre les deux end if
regarde ton indentation tu a un if sans end if aligné mais le end if sous le for
(ce n'est pas du au parenthèse, c'est juste que maintenant que tu na plus d'erreur sur les paracentèses il te montre la suivante )

[vibos]

Bonjour Krovax,

J'ai poster trop tot.

j'ai trouver l'erreur mais le temps de corriger mon poste tu à répondu plus vite que moi.

Merci pour ton aide très rapide

[LeForestier]

bonjour LeForestier,

Je pense qu'elle ne cherche pas dans les sous-dossiers.
Je retourne en croisade contre le VBA .

Merci de ton aide

Attention, avec la macros tel qu'elle est ça ne va de toutes façon pas chercher dans les sous-dossiers, si besoin tu dit, faudra modifier le code.
A+

[vibos]

Rebonjour,

Je bloque encore
N'arrivant pas à utiliser ShowSubfolder, j'ai déjà voulu tester le code existant.
Mais il ne trouve pas le chemin d'accès.
Que je mette :

Code :

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

FileCopy Chemin & "\" & f1.Name, "C:\Documents and Settings\moi\Mes documents\test2\"

ou

Code :

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

FileCopy Chemin & f1.Name, "C:\Documents and Settings\moi\Mes documents\test2\"

une idée ?

Je remet le code complet car il y a des petits changements

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
30
31
Sub LireRepertoir2()
'lire les fichiers d'un répertoir
Dim fs, F, f1, S, sf
Dim Ext As String, Chemin As String
Dim i As Integer
Dim x As String
    Chemin = "\\blablabla\fiche\" 'adapter au répertoir où sont situés les fichiers.
    Ext = "pdf"
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    For Each f1 In sf
        If Right(f1.Name, 3) = Ext Then 'pour être certain que c'est un bon fichier
            'ici tester le nom
             'For i = 1 To 1700
                If f1.Name = "8816501-fiche.pdf" Then
'Cells(i, 240) Then
             'et en faire ce que l'ont veux
 
             ' Sous Microsoft Windows:
                 '   OldName = Chemin & "\" & f1.Name
                  '  NewName = "C:\Documents and Settings\moi\Mes documents\test2\"
                ' Déplace et renomme le fichier.
                   ' Name OldName As NewName
                FileCopy Chemin & "\" & f1.Name, "C:\Documents and Settings\moi\Mes documents\test2\"
 
                End If
           ' Next
        End If
    Next
End Sub

Merci encore.