Bonjour,
Je cherche à écrire un code vba, qui me permettra de chercher un fichier depuis son nom sous forme de numéro inscris dans une cellule, puis mettre le résultat de la recherche sous forme de chemin du fichier trouvé dans une cellule.
Je dispose d'un tableau dans lequel j'ai une colonne "CHILD OP", ce sont des N°OF. Aussi les cellules de la colonne "CHILD PRODUCT" sont des N°Série.
L'objectif est d'écrire une boucle qui va parcourir toutes les colonnes de mon tableau, ligne par ligne pour chercher si on a un fichier avec comme nom un N°OF - N°Série existe dans notre répertoire définit fixe. Si le fichier existe et que dans son Nom on a "MT", mettre hyperlink de ce fichier dans cellule colonne "MT" de la ligne associé, pareil pour "PT"/ "UT"/"VT"...
J'ai commencé par établir un code en s'aidant d'internet, mais je penses avoir plusieurs erreurs que je n'arrive pas à corriger ou à m'en apercevoir.
Si qq peut m'aider svp je bloque sur ca ^^ MERCI !
Voici mon code !
Je cherche à écrire un code vba, qui me permettra de chercher un fichier depuis son nom sous forme de numéro inscris dans une cellule, puis mettre le résultat de la recherche sous forme de chemin du fichier trouvé dans une cellule.
Je dispose d'un tableau dans lequel j'ai une colonne "CHILD OP", ce sont des N°OF. Aussi les cellules de la colonne "CHILD PRODUCT" sont des N°Série.
L'objectif est d'écrire une boucle qui va parcourir toutes les colonnes de mon tableau, ligne par ligne pour chercher si on a un fichier avec comme nom un N°OF - N°Série existe dans notre répertoire définit fixe. Si le fichier existe et que dans son Nom on a "MT", mettre hyperlink de ce fichier dans cellule colonne "MT" de la ligne associé, pareil pour "PT"/ "UT"/"VT"...
J'ai commencé par établir un code en s'aidant d'internet, mais je penses avoir plusieurs erreurs que je n'arrive pas à corriger ou à m'en apercevoir.
Si qq peut m'aider svp je bloque sur ca ^^ MERCI !
Voici mon code !
VB:
Sub Aspirateur()
Dim Fso As Object, Rep As String
Dim f1 As Object, f2 As Object, Present As Integer
i = 2
NomIncomplet = Cells(i, 4) & "-" & Cells(i, 5) & "-"
'& Cells(1, 7) & "-" & Cells(1, 8) & "-" & Cells(1, 9) & "-" & Cells(1, 10)
Present = 0
Rep = "C:\Users\" & Environ("Username") & "\Alstom\DLC - Documents\MS\CND" & "\" 'Définit le répertoire contenant les fichiers, c'est à dire la directory courante
Set Fso = CreateObject("Scripting.FileSystemObject")
For Each f1 In Fso.GetFolder(Rep).SubFolders ' Dans le dossier
' et chaque sous dossiers
For Each f2 In f1.Files
' Si le nom du fichier contient le morceau de nom cherché alors
If f2.Name Like "*" & NomIncomplet & "*" = True Then
If f2.Name Like "*" & Cells(1, 7) & "*" = True Then
Set MonApp = CreateObject("Shell.Application")
Chemin = Rep & f2.Name
Cells(i, 7) = f2.Name
MonApp.Open (Chemin)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 7), _
Address:=FileItem.ParentFolder & "\" & f2.Name
Set MonApplication = Nothing
Present = 1
End If
If f2.Name Like "*" & Cells(1, 8) & "*" = True Then
Set MonApp = CreateObject("Shell.Application")
Chemin = Rep & f2.Name
Cells(i, 8) = f2.Name
MonApp.Open (Chemin)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 8), _
Address:=FileItem.ParentFolder & "\" & f2.Name
Set MonApplication = Nothing
Present = 1
End If
If f2.Name Like "*" & NomIncomplet & "*" & Cells(1, 9) & "*" = True Then
Set MonApp = CreateObject("Shell.Application")
Chemin = Rep & f2.Name
Cells(i, 9) = f2.Name
MonApp.Open (Chemin)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 9), _
Address:=FileItem.ParentFolder & "\" & f2.Name
Set MonApplication = Nothing
Present = 1
End If
If f2.Name Like "*" & NomIncomplet & "*" & Cells(1, 10) & "*" = True Then
Set MonApp = CreateObject("Shell.Application")
Chemin = Rep & f2.Name
Cells(i, 10) = f2.Name
MonApp.Open (Chemin)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 10), _
Address:=FileItem.ParentFolder & "\" & f2.Name
Set MonApplication = Nothing
Present = 1
End If
Set MonApp = CreateObject("Shell.Application")
Chemin = Rep & f2.Name
MonApp.Open (Chemin)
Set MonApplication = Nothing
Present = 1
End If
Next f2
Next f1
i = i + 1
End Sub
