Cherche un élément dans un nom de fichier et l'extraire dans une colonne

Bonjour à tous,

Je suis novice en VBA et c'est la première fois que j'écris sur un forum.

N'hésitez pas à me dire si je n'ai pas suivi la marche à suivre.

Je cherche à faire la chose suivante :

J'ai dans un tableau excel une colonne avec des numéros de commande et une autre avec le code matière (voir image 1). Je cherche à aller chercher dans un dossier précis (composé de plusieurs sous-dossier), le fichier qui correspond à cette commande, puis extraire le numéro de certificat que l'on retrouve dans le nom du fichier (voir image 2).

Le fichier est toujours écris de la même façon : Le nom du fournisseur - le n° du certificat que je recherche - le n° de la commande - le nom de la matière.

Comment puis-je faire cela ?

Merci à tous pour vos réponses,

Belle journée

Bonjour Laurineu,

C'est marrant j'ai eu à faire une boucle vraiment identique ce matin, vous tombez bien !

Ci-après le code que j'ai un peu adapté à votre cas.

Trois remarques :

• vous devez adapter le chemin d'accès au votre bien entendu
• j'ai supposé que vos fichiers étaient des docx faute d'information
• vous devez adapter les numéros de ligne et colonne dans le code comme indiqué

Vous pouvez ensuite exécuter

Sub Laurineau()
  Dim StrFile As String
  StrFile = Dir("C:\votreCheminDacces\FOURNISSEUR*.docx")          ' A CORRIGER !!

  Dim rowI As Long, colFourni As Long
  rowI = 6  ' rentrer ici le num�ro de ligne � partir duquel vous souhaitez ins�rer vos valeurs
  colFourni = 3 ' rentrer ici le num�ro de colonne fournisseur (par exemple colonne C = 3)

  Dim infosExtraites() As String
  Dim infosUtiles(0 To 1) As String

  Do While Len(StrFile) > 0
    ' d�coupe du nom de fichier entre les - : [Fournisseur, N�XXX Cde, Matiere Z]
    infosExtraites = VBA.Split(StrFile, " - ") 'StrFile = "FOURNISSEUR - N�XXXXX Cde - Matiere 1.docx"

    ' extraction du code fournisseur
    infosExtraites(1) = VBA.Mid$(infosExtraites(1), 3)
    infosUtiles(0) = VBA.Trim(VBA.Left$(infosExtraites(1), VBA.InStr(1, infosExtraites(1), " Cde")))

    ' extraction de la matiere (on eleve ".docx" � la fin)
    infosUtiles(1) = VBA.Left$(infosExtraites(2), Len(infosExtraites(2)) - 5)

    ' ecriture dans Excel
    ActiveSheet.Cells(rowI, colFourni).Value2 = infosUtiles(0)
    ActiveSheet.Cells(rowI, colFourni + 1).Value2 = infosUtiles(1)

    rowI = rowI + 1

    StrFile = Dir
  Loop
End Sub

C'est parfait tout marche !

De ce que je comprends, je ne peux appliquer ce programme que pour un dossier particulier.

Comment l'on peut faire pour appliquer ce programme à plusieurs dossiers ?

Pour l'appliquer à plusieurs dossiers c'est assez facile. Il va falloir ajouter 1 argument à ce sub :

Comme vous le mentionnez, l'adresse du fichier.

Ainsi on écrit :

Sub Laurineau(chemin As String)
  Dim StrFile As String
  StrFile = Dir(chemin & "\FOURNISSEUR*.docx") 

Mais attention ce n'est pas tout ! il faut aussi, vous vous en doutez, mettre à jour la "dernière ligne remplie", autrement on va écraser les données précédentes à chaque fois.

Pour cela on va remplacer le numéro de ligne dans la macro pour le calculer de manière dynamique en allant en bas de la feuille et remontant. Ainsi on est sauvé.

  Dim rowI As Long, colFourni As Long
  colFourni = 3
   rowI = ActiveSheet.Cells(ActiveSheet.Rows.Count, colFourni).End(xlUp).Row + 1

Il ne vous reste plus qu'à appeler la macro depuis une autre macro dans laquelle vous bouclez sur la liste de vos fichiers, par exemple :

Sub boucle()
   Dim mesChemins(1 to 3) As String, chemin As Variant
   mesChemins(1) = "C:\dossier1"
   mesChemins(2) = "C:\dossier2"
   mesChemins(3) = "C:\dossier3"

   For each chemin in mesChemins
     Laurineau chemin
   Next chemin
End Sub

Sub Laurineau(chemin As String)
  Dim StrFile As String
  StrFile = Dir(chemin & "\FOURNISSEUR*.docx")

  Dim rowI As Long, colFourni As Long
  colFourni = 3 ' rentrer ici le num�ro de colonne fournisseur (par exemple colonne C = 3)
  rowI = ActiveSheet.Cells(ActiveSheet.Rows.Count, colFourni).End(xlUp).Row + 1

  Dim infosExtraites() As String
  Dim infosUtiles(0 To 1) As String

  Do While Len(StrFile) > 0
    ' d�coupe du nom de fichier entre les - : [Fournisseur, N�XXX Cde, Matiere Z]
    infosExtraites = VBA.Split(StrFile, " - ") 'StrFile = "FOURNISSEUR - N�XXXXX Cde - Matiere 1.docx"

    ' extraction du code fournisseur
    infosExtraites(1) = VBA.Mid$(infosExtraites(1), 3)
    infosUtiles(0) = VBA.Trim(VBA.Left$(infosExtraites(1), VBA.InStr(1, infosExtraites(1), " Cde")))

    ' extraction de la matiere (on eleve ".docx" � la fin)
    infosUtiles(1) = VBA.Left$(infosExtraites(2), Len(infosExtraites(2)) - 5)

    ' ecriture dans Excel
    ActiveSheet.Cells(rowI, colFourni).Value2 = infosUtiles(0)
    ActiveSheet.Cells(rowI, colFourni + 1).Value2 = infosUtiles(1)

    rowI = rowI + 1

    StrFile = Dir
  Loop
End Sub