Discussion :

[damfury]

Bonjour a tous,

J'essaie de recuperer le chemin de mon fichier et de l'incorporer a ma table a partir du nom partiel du fichier.

Il faut que je recherche ce nom de fichier sans son extension dans un repertoire connu.

J'ai trouver ce code mais il ne fonctionne pas. Si vous pouviez jeter un coup d'oeil et m'aider a l'ameliorer. Merci d'avance

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
Private Declare Function SearchTreeForFile _
Lib "imagehlp" (ByVal RootPath As String, _
ByVal InputPathName As String, _
ByVal OutputPathBuffer As String) As Long
 
Public Function chercherFichier(NomFichier As String, _
  Root As String)
Dim Resultat As Long
'Creer un buffer
tempStr = String(260, 0)
'Lance la recherche
Resultat = SearchTreeForFile(Root, NomFichier, Temp)
If Resultat <> 0 Then _
  chercherFichier = Left$(NomFichier, InStr(1, NomFichier, Chr$(0)) - 1) 'ca plante ici
End Function

J'utilise access 2007...

[DMboup]

Est ce que le nom du fichier comporte le chemin du répertoir aussi?

Si tu as

- un répertoire monrep="Lecteur:\dossiser\sousdos\"
- des fichiers (test.xls, toto.txt, tuto.html)

qu'est ce que tu cherches?

[helas]

et ceci

Code :

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

1
2
 
 chercherFichier  = Mid$(tempstr, InStr(1, tempstr, NomFichier),len(NomFichier)-4 )

[damfury]

Ce que je cherche c'est que je possede le nom partiel de mon fichier qui devrait normalement etre suffisant pour l'identifier.

Ce nom est de la forme: LIC-240-A11-A il peut y avoir quelquechose apres mais ce ne sont que des details.

Je voudrais pouvoir rechercher ce nom de fichier dans un repertoire et enregistrer le chemin du fichier trouve dans ma base.

A savoir que je ne peut pas utiliser l'extension du fichier qui peut etre de type different suivant le fichier.

[damfury]

Merci pour ta reponse Helas mais ca ne fonctionne toujours pas.

Merci quand meme.

[DMboup]

Je voudrais pouvoir rechercher ce nom de fichier dans un repertoire et enregistrer le chemin du fichier trouve dans ma base.

A savoir que je ne peut pas utiliser l'extension du fichier qui peut etre de type different suivant le fichier.

A supposer que tu connais le repertoire de recherche, il faut le parcourir et sur chaque fichier trouvé, faire un Instr et tester le résultat

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
 
    Dim TonRepertoire As String, NomFichier As String, FichierTrouve As String
    Dim MonRes As Variant, Resultat As String, i As Integer
 
    TonRepertoire = "C:\Page\"
    NomFichier = "Index"
    FichierTrouve = ""
    FichierTrouve = Dir(TonRepertoire, vbNormal)
 
MonRes = 0
i = 0
Do While i = 0
      MonRes = InStr(1, FichierTrouve, NomFichier, 1)
      If MonRes <> 0 Then
           Resultat = FichierTrouve
           i = 1
      End If
      FichierTrouve = Dir ' Fichier Suivant
Loop
If i = 0 Then
    MsgBox "Aucun fichier trouvé"
Else
    MsgBox "un fichier trouvé. Nom du fichier : " & Resultat & " Nom complet : " & TonRepertoire & Resultat
End If

[Access Newbie]

Ou encore :

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
32
33
34
35
36
 
 
Function SearchFile(strDir As String, Optional strExt = "*.*") As String
'Retourne le nom des fichiers presents dans un dossier passe en parametre(strDir),
'en fonction de l'extension recherchée (strExt)
'La recherche ne se fait pas dans les sous répertoires
'Ex : filesToSearch = SearchFile("C:\","*.xls") -> on recherche toous les fichiers excel presents dans c:
'retourne un resultat de la forme fichier1;fichier2;....
 
On Error GoTo ErrSearchFile
 
Dim i As Integer
Dim file As String
 
    With Application.FileSearch
        .NewSearch
        .LookIn = strDir
        .FileName = strExt
 
            If .Execute > 0 Then
                For i = 1 To .FoundFiles.Count
                    file = FileName(.FoundFiles(i))
                    SearchFile = SearchFile & strDir & file & ";"
                Next i
                SearchFile = Left(SearchFile, Len(SearchFile) - 1)
            End If
 
    End With
 
    Exit Function
 
ErrSearchFile:
    SearchFile = Null
    MsgBox err.Number & vbCrLf & vbCrLf & err.Description, vbCritical
 
End Function

Ce code renvoie la liste des elements trouvés séparés par des ";". A adapter pour ton cas.

En esperant t'avoir aidé

[Heureux-oli]

Une autre piste :

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
 
Sub chercherfichier()
Dim oDlg As FileDialog
Dim fso As FileSystemObject
Dim oFold As Folder
Dim oFil As File
Dim stTemp As String
Dim StFold As String
stTemp = InputBox(" Donnez le nom du fihcier ")
 
Set fso = New FileSystemObject
Set oDlg = Application.FileDialog(msoFileDialogFolderPicker)
With oDlg
    .Show
End With
StFold = oDlg.SelectedItems(1)
Set oFold = fso.GetFolder(StFold)
 
For Each oFil In oFold.Files
    If Left(oFil.Name, Len(stTemp)) = stTemp Then
        MsgBox oFil.Path
    End If
Next oFil
 
Set oFold = Nothing
Set fso = Nothing
 
 
End Sub

Tu dois ajouter à ton projet la référence à Microsoft File Scripting Runtime

Une tuto qui en parle ici http://warin.developpez.com/access/fichiers/

[damfury]

Tout d'abord merci a tous pour toutes ces reponses ca fait vraiment plaisir.

Ensuite il faut que je precise qu'il va faloir que j'effectue cette recherche pour environ 5000 enregistrements (avec des sous dossiers) donc j'aimerais savoir laquelle de vos solutions serait la plus rapide.

Merci d'avance.

[Access Newbie]

Ma solution ne recherche pas dans les sous dossiers.

dsl

[damfury]

Bon alors j'ai reussi a mettre en oeuvre une solution:

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
Private Declare Function SearchTreeForFile _
Lib "imagehlp" (ByVal RootPath As String, _
ByVal InputPathName As String, _
ByVal OutputPathBuffer As String) As Long
Public SResult As String
 
Sub scan(ByVal dossier As Folder, ByVal aTrouver As String)
 
 
    For Each fichier In dossier.Files
        If InStr(fichier.Name, aTrouver) > 0 Then 'tu fais ce que tu veux car t'as trouvé fichier.name = nom du fichieret fichier.path = chemin du fichier
        SResult = fichier.Path
        Exit Sub 'quitte ensuite si trouve
    End If
    Next 'juste au cas où t'as des sous-dossier sinon, zappe cette partie
        For Each sousdossier In dossier.SubFolders
        Call scan(sousdossier, aTrouver)
    Next
 
End Sub

Le seul probleme c'est que ce processus est vraiment long donc on m'a conseille d'utiliser une API.

J'ai pu trouver le code qui suit mais je ne sais pas comment faire pour l'utiliser et recuperer mon chemin

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
'----------------------------------------
'------Déclarations propres aux API------
'----------------------------------------
'---Les constantes---
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
 
'---Les API---
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
         (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
         (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
 
'---Les types---
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
 
Private Type WIN32_FIND_DATA
    dwFileAttributes    As Long
    ftCreationTime      As FILETIME
    ftLastAccessTime    As FILETIME
    ftLastWriteTime     As FILETIME
    nFileSizeHigh       As Long
    nFileSizeLow        As Long
    dwReserved0         As Long
    dwReserved1         As Long
    cFileName           As String * MAX_PATH
    cAlternate          As String * 14
End Type
 
'----------------------------------------------
'------Déclarations propres à la fonction------
'----------------------------------------------
Private Type ListeFichier
    Fichiers()  As WIN32_FIND_DATA
    chemin()    As String * MAX_PATH
    Nombre      As Long
End Type
 
'----------------------------------------------
'------------Variables globales----------------
'----------------------------------------------
Dim rsFic               As ADODB.Recordset
Dim Repertoire          As String
Dim FichiersRecherchés  As String
 
'****************************************************************
' Initialisation du recordset
'****************************************************************
Private Sub init_Recordset()
    Set rsFic = New ADODB.Recordset
    rsFic.CursorLocation = adUseClient
    rsFic.CursorType = adOpenDynamic
 
    '-- Creation de champ pour la recherche sur les versions precedentes
    rsFic.Fields.Append "Nom", adVarChar, 50
    rsFic.Fields.Append "Chemin", adVarChar, 255
    rsFic.Open
End Sub
 
'****************************************************************
' Configuration pour le lancement de la recherche
'****************************************************************
Sub LancerLaRecherche_API()
    ' Alogtihme récursif
    '---Déclaration des variables---
    Dim ResultatRecherche As ListeFichier
    Dim NombreOccurence As Long
    Dim i
    Dim intI As Integer
    Dim tmp As String
 
    init_Recordset
   '-- Je récupére le chemin
    Repertoire = Frm_Main.chemin1
    '--Je récupére le nom du fichier à chercher
     FichiersRecherchés = Frm_Main.FichierRec & ".txt"
 
    '---Recherche de tous les fichiers souhaités sur le lecteur prévu---
    NombreOccurence = Rechercher(Repertoire, FichiersRecherchés, ResultatRecherche)
    ' Toutes les informations de la recherche sont dans la variables ResultatRecherche
    Select Case ResultatRecherche.Nombre
        Case 0
            MsgBox "AUCUN FICHIER NE CORRESPOND", vbCritical
        Case Else
            '-- On récupère le chemin complet ainsi que le nom du fichier recherché
            Frm_Main.chemin1 = rsFic!chemin.Value & FichiersRecherchés
    End Select
    On Error Resume Next
    If rsFic.Status = adStateOpen Then rsFic.Close
    Set rsFic = Nothing
End Sub
 
 
'****************************************************************
' La fonction Rechercher :
'   Cette fonction recherche tous les fichiers dans le
'   répertoire spécifié et ses sous-repertoires.
'   Elle retourne le nombre d'occurences trouvées
'****************************************************************
Private Function Rechercher(chemin As String, FichierR As String, _
                            ResultatRecherche As ListeFichier) As Long
 
    '---Déclaration des variables---
    Dim lpFindFileData As WIN32_FIND_DATA
    Dim hFindFile As Long
    Dim lgRep As Long
    Dim CheminRep As String
 
    Dim NomDuFichier As String
 
    '---Recherche tous les fichiers demandés dans le répertoire Chemin---
    hFindFile = FindFirstFile(chemin & FichierR, lpFindFileData)
    If hFindFile <> INVALID_HANDLE_VALUE Then
        Do
            ' Mémorise
            ResultatRecherche.Nombre = ResultatRecherche.Nombre + 1
            ReDim Preserve ResultatRecherche.chemin(1 To ResultatRecherche.Nombre)
            ReDim Preserve ResultatRecherche.Fichiers(1 To ResultatRecherche.Nombre)
            ResultatRecherche.chemin(ResultatRecherche.Nombre) = chemin
            ResultatRecherche.Fichiers(ResultatRecherche.Nombre) = lpFindFileData
 
            NomDuFichier = lpFindFileData.cFileName
            'Nettoyage du string renvoyé par l'API
            NomDuFichier = Replace(NomDuFichier, Chr(0), "")
            NomDuFichier = Trim(NomDuFichier)
 
            'S'il ne s'agit pas du dossier...
            If NomDuFichier <> "." And NomDuFichier <> ".." Then
                rsFic.AddNew
                rsFic!nom.Value = NomDuFichier
                rsFic!chemin.Value = chemin
                rsFic.Update
                rsFic.Sort = "Nom DESC"
            End If
 
            ' Initialise lpFindFileData (Variable texte uniquement)
            lpFindFileData.cAlternate = String$(14, 0)
            lpFindFileData.cFileName = String$(MAX_PATH, 0)
        Loop Until FindNextFile(hFindFile, lpFindFileData) = 0
    End If
 
    FindClose hFindFile
 
    '---Recherche dans les sous-répertoires---
    hFindFile = FindFirstFile(chemin & "*.*", lpFindFileData)
    If (hFindFile <> INVALID_HANDLE_VALUE) Then
        Do
            ' Si c'est un répertoire on continu le recherche
            If (lpFindFileData.dwFileAttributes And _
                FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
                ' Extraction du nom du répertoire
                CheminRep = Mid$(lpFindFileData.cFileName, 1, _
                            InStr(1, lpFindFileData.cFileName, Chr$(0)) - 1)
                ' Attention dans les sous-répertoire aux
                ' répertoires . et .. (Retour répertoire parent)
                If (CheminRep <> ".") And (CheminRep <> "..") Then
                    CheminRep = chemin & CheminRep & "\"
                    Rechercher = Rechercher(CheminRep, FichierR, ResultatRecherche)
                End If
            End If
        Loop Until FindNextFile(hFindFile, lpFindFileData) = 0
    End If
 
    FindClose hFindFile
 
    '---Retourne le nombre d'occurrences trouvées---
    Rechercher = ResultatRecherche.Nombre
End Function

Merci pour vos explications.