Chercher fichier dans un dossier en fonction de données dans feuille Excel

Bonjour,

je suis plus que novice en VBA.

Je vais tout d'abord vous exposer ce que je veux réaliser, puis par la suite là où je suis rendu.

Je dispose d'un tableau excel avec une feuille :

colonne A : des numéros de dossier tous différents qui sont répartis de A1 à A2000 environ, il peut y avoir des cellules vides entre tous ces numéros de dossiers

colonne W : je souhaite y répertorier par une croix l'existence d'un fichier dans un dossier S:/doc/ comportant le numéro de dossier ainsi que d'autres informations qui ne rentrent pas en compte dans ce pointage. Je veux faire automatiquement apparaître une croix dans la colonne W sur la ligne correspondant au numéro de dossier

J'arrive avec le code ci-dessous à le faire pour une cellule, mais je bloque au-delà.

Pourriez-vous me venir en aide ?

Merci beaucoup par avance,

Option Explicit

Public Function FichierExiste(MonFichier As String) 

 If MonFichier <> "" And Len(Dir(MonFichier)) > 0 Then

 FichierExiste = True 

 Else 

 FichierExiste = False 

 End If

End Function

Sub TesteSiFichierExiste()

Dim MonFichier As String

Dim chemin As String

chemin = "S:\doc\"

MonFichier = chemin & Range("A2") & "*"

'affiche une croix dans la colonne de pointage 

 If FichierExiste(MonFichier) = True Then 

 Cells(2, 23) = "X" 

 Else 

 Cells(2, 23) = "" 

 End If

End Sub

Je ne comprends pas bien la raison de cette "*" (générique).
Autre question : A2 n'est pas clair. La liste des fichiers dont il faut rechercher la présence dans le dossier s:\doc est sur la ligne 2 ou la colonne A ?

S'il s'agit de la colonne A, cette recherche en VBA peut s'écrire sans fonction. Tout simplement :

Dim monFichier As String, chemin As String
    Dim i As Integer, nL As Integer

    chemin = "d:\doc\"
    nL = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To nL
        monFichier = chemin & Range("A" & i) & "*"
        Cells(i, 23) = ""
        If Range("A" & i) <> "" And Dir(monFichier) <> "" Then Cells(i, 23) = "X"
    Next i

Bonjour et merci pour ce retour,

Je ne comprends pas bien la raison de cette "*" (générique).

Les nombreux fichiers s'appellent par exemple 21825_NOM.Prenom.extension . "*" est pour ne pas prendre en compte la suite du nom du fichier

Autre question : A2 n'est pas clair. La liste des fichiers dont il faut rechercher la présence dans le dossier s:\doc est sur la ligne 2 ou la colonne A ?

La liste du début des noms de fichiers est dans la colonne A.

Cordialement,

Ca me paraît risqué et dangereux, mais c'est ton choix.

Donc tu remplaces

monFichier = chemin & Range("A" & i).Value

par :

monFichier = chemin & Range("A" & i) & "*"

Merci beaucoup :)

Cela marche très bien avec monFichier = chemin & Range("A" & i) & "*"

En revanche, cela ne marche pas quand je mets monFichier = chemin & Range("A" & i).Value

Je vais me plonger dans ce code que vous m'avez proposé pour le comprendre car il est très efficace. Peut-il également faire les recherches dans les sous-dossiers?

Merci par avance,

Il est normal que ça ne marche pas avec Value, laissez tomber.
Il est tout à fait possible d'effectuer cette recherche dans une arborescence (sous-dossiers). Pour cela, on traite la recherche par récursivité. C'est ce que vous voulez faire ?

Si c'est le cas, essayez cette macro (un peu plus complexe) :

Option Explicit

Sub Macro1()
    Dim fso As Object, dossier As String

    Set fso = CreateObject("Scripting.FileSystemObject")
    dossier = "s:\doc"
    scan fso, dossier
End Sub

Private Sub scan(fso, dossier)
    Dim fic As Object, fo As Object, table() As String
    Dim nL As Long, compt As Long, i As Long

    For Each fic In fso.GetFolder(dossier).Files
        compt = compt + 1
        ReDim Preserve table(compt)
        table(compt) = fic.Name
        nL = Cells(Rows.Count, "A").End(xlUp).Row
        For i = 2 To nL
            Cells(23, i) = ""
            If Cells(i, 1) <> "" And Left(table(compt), Len(Cells(i, 1))) = Cells(i, 1) Then
                Cells(i, 23) = "X"
                Exit For
            End If
        Next i
    Next fic

    For Each fo In fso.GetFolder(dossier).subFolders
        scan fso, dossier & "\" & fo.Name
    Next fo
End Sub

Merci beaucoup pour ce retour,

j'essaie de comprendre la macro, je la teste et vous en fait un retour.

Cordialement,

Rebonjour,

je n'arrive malheureusement pas à faire fonctionner la dernière macro. La première marche parfaitement, mais pour la deuxième je bloque. Le référencement des fichiers a pourtant l'air de bien se faire...Je vous ai mis le fichier en pièce jointe si vous avez du temps ;)

Encore merci, c'est vraiment top rien que pour la première.

Cordialement,

Normal, tu as changé le type de données en colonne "A".

Essaye de remplacer :

If Cells(i, 1) <> "" And Left(table(compt), Len(Cells(i, 1))) = Cells(i, 1) Then

par :

If Trim(Cells(i, 1)) <> "" And Left(table(compt), Len(Trim(Cells(i, 1)))) = Trim(Cells(i, 1)) Then

Merci beaucoup,

cela marche parfaitement maintenant.

Cordialement,

Rebonjour,

j'ai remarqué deux choses :

- elle ne détecte le numéro de dossier que s'il est au début du nom du fichier, s'il est au milieu il ne le détecte pas.

- une fois détecté, si je supprime le fichier, la case ne repasse pas en blanc et conserve la "X"

Est-ce possible d'y remédier ?

Merci par avance,

Ce sera ma dernière correction, car tout n'était pas prévu ou annoncé au départ. D'où le contenu de ma signature. Rassure-toi tu es loin d'être le seul.

Option Explicit

Sub Macro1()
    Dim fso As Object, dossier As String, nL As Long

    nL = Cells(Rows.Count, "A").End(xlUp).Row
    Range("W2:W" & nL).Value = ""

    Set fso = CreateObject("Scripting.FileSystemObject")
    dossier = "D:\doc"
    scan fso, dossier
End Sub

Private Sub scan(fso, dossier)
    Dim fichier As Object, folder As Object, table() As String
    Dim nombreligne As Long, compt As Long, i As Long

    For Each fichier In fso.GetFolder(dossier).Files
        compt = compt + 1
        ReDim Preserve table(compt)
        table(compt) = fichier.Name
        nombreligne = Cells(Rows.Count, "A").End(xlUp).Row
        For i = 2 To nombreligne
            Cells(23, i) = ""
            If Trim(Cells(i, 1)) <> "" And InStr(table(compt), Trim(Cells(i, 1))) > 0 Then
                Cells(i, 23) = "X"
                Exit For
            End If
        Next i
    Next fichier

    For Each folder In fso.GetFolder(dossier).subFolders
        scan fso, dossier & "\" & folder.Name
    Next folder
End Sub

Merci beaucoup, cela fonctionne au top :)

Par contre j'avais modifié nL par nombreligne pour mieux suivre, j'ai donc remis nL partout car c'était différent entre le Sub et le Private Sub sinon cela n'arrivait pas jusqu'à la fin de mon tableau :)

Encore merci, t'es un chef. Cela va énormément m'aider à progresser en vba une fois que j'aurais bien assimilé tout ce code :)

A bientôt,

cordialement,