Recherche de fichier et creation de lien MACRO VBA probleme

Question

Bonjour à tous,

tous d'abord merci a ce site qui m'a beaucoup aidé.

Cela dit, aujourd'hui je rencontre un probleme avec une macro que je souhaite modifiée. Celle-ci est censé recherché dans un dossier les fichiers portant la meme reference, et me creer un lien hypertexte dans une colonne de mon fichier excel.

La macro fonctionne, mais uniquement dans le cas ou le dossier contenant le fichier porte exactement le meme nom que ma colonne de references dans mon fichier excel.

Par exemple :

Dans ma colonne est inscrit "1322131" , si le fichier s'apelle "1322131 plan de fab " il ne le trouve pas.

Ci dessous le code que j'utilise, qui n'a pas été crée par moi (mes connaissances en VBA sont plus que basiques) :

(Code correspond a mes references de recherche).

J'aimerai que la macro trouve le fichier directement dans le repertoire "temp" contenant au moins la reference recherché (colonne excel).

Public Sub F3_Générer_Les_Liens_REP()

Dim nomenclatureSheet As Worksheet
Dim sRepertoire As String
Static FSO As FileSystemObject
Dim oSourceFolder As Scripting.Folder
Dim oFile As Scripting.File
Dim tableNomenclature As ListObject
Dim CODE, type_ele, majeur, mineur As String
Dim iCode, iType, iMajeur, iMineur, iPdf, iPdfLink As Long
Dim i As Integer
Dim filename, pathname, datapath As String
Dim links() As String
Dim oFile_extension As String

' Pathname
With Application.ActiveWorkbook ' ou ThisWorkbook
filename = Left(.Name, InStr(.Name, ".xls") - 1)
pathname = .Path
End With

datapath = pathname & "\" & filename & "\TEMP\"

' Vérifie l'existence du taleau de nomenclature

If Not isNomenclatureExist("MsgLienREP") Then Exit Sub
Set tableNomenclature = fctSpecifiedTable(nomenclatureSheetName, nomenclatureTableName)
Set nomenclatureSheet = Application.Worksheets(nomenclatureSheetName)

Set FSO = CreateObject("Scripting.FileSystemObject")

iCode = Range(tableNomenclature.Name & "[CODE]").Column
iType = Range(tableNomenclature.Name & "[TYPE_ELE]").Column
iMajeur = Range(tableNomenclature.Name & "[MAJEUR]").Column
iMineur = Range(tableNomenclature.Name & "[MINEUR]").Column
iPdf = Range(tableNomenclature.Name & "[pdf]").Column
iPdfLink = Range(tableNomenclature.Name & "[pdfLink]").Column

ProgressBar.Text.Caption = "Chargement des liens pdf en cours..."
ProgressBar.Show vbModeless

ReDim links(1 To tableNomenclature.Range.Rows.Count - 1)

For i = 2 To tableNomenclature.Range.Rows.Count
CODE = Replace(nomenclatureSheet.Cells(i, iCode), " ", "")
type_ele = nomenclatureSheet.Cells(i, iType)
majeur = nomenclatureSheet.Cells(i, iMajeur)
mineur = nomenclatureSheet.Cells(i, iMineur)
sRepertoire = datapath & CODE & ""

' Contrôle de la Progress Bar
ProgressBar.Bar.Value = i / tableNomenclature.Range.Rows.Count * 100
DoEvents

If CODE = "1166616" Then
'MsgBox sRepertoire
End If

If DossierExiste(sRepertoire) Then
Set oSourceFolder = FSO.GetFolder(sRepertoire)
For Each oFile In oSourceFolder.Files
oFile_extension = LCase(Mid(oFile.Name, InStrRev(oFile.Name, ".")))
'If oFile.Type = "Adobe Acrobat Document" Then
If oFile_extension = ".pdf" Or oFile_extension = ".doc" Then
'Cells(i, iPdf) = "pdf"
'Set objLink = Cells(i, iPdf).Hyperlinks.add(Cells(i, iPdf), oFile.Path)
links(i - 1) = oFile.Path
'MsgBox oFile.Path
Exit For
End If
Next oFile

End If
Next i

Unload ProgressBar

ActiveSheet.Unprotect
nomenclatureSheet.Activate
Range(Cells(2, iPdfLink), Cells(tableNomenclature.Range.Rows.Count, iPdfLink)) = Application.WorksheetFunction.Transpose(links)
ActiveSheet.Protect UserInterfaceOnly:=True

Stop_Sub:

End Sub

Invité · Answer

Une petite présentation ICI serait la bienvenue Si vous ne l'avez pas encore fait, je vous invite à lire : - La charte du forum - Quelques fonctionnalites du forum à connaître Regardez aussi les petites icônes mises à votre disposition dans la barre de menu qui : - vous permettent de poster un code ( &lt;/&gt; ) - de citer une phrase (" ") - ou de clôturer un fil lorsque vous avez terminé ( V ) Concernant votre 1er post, merci de l'éditer (si vous pouvez) avec le bouton Puis de couper votre code, de cliquer sur le bouton et de le coller dans la fenêtre qui apparait, puis "Insérer" Merci pour votre participation Cordialement...