[XL-2007] recherche multiple sur mon disque dur a partir d une colone [Résolu]

[redbull222]

Bonjour a tous,

je recherche une solution afin de rechercher dans windows les valeur d une colone

ex: les valeurs suivante sont des .jpg

7179649
9644949
9934075
B473857
8031012
6810616

comment faire une recherche multiple sur mon disque dur a partir d une colone d excel

Merci

[jfontaine]

Bonjour,

Une solution est d'utiliser les API Windows

Code a coller dans un module

Code :

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
Option Explicit
 
Public Const MAX_PATH = 260
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const ERROR_NO_MORE_FILES = 18&
 
Public strRetour As String
 
'Struture utilisée par WIN32_FIND_DATA
Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
 
'Struture utilisée par FindFirstFile
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
 
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, lpFindFileData As _
WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long
'Détermine la longeur d'une chaine passée en argument.
Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _
(ByVal lpString As String) As Long
 
Function Fnc_Recherche_Repertoire_API(Rep As String, Fichier As String) As String
Dim WFD As WIN32_FIND_DATA
Dim Handle_Recherche As Long
Dim Suite_Recherche As Long
Dim FileName As String
Dim nb_car As String
Dim Rep_Recherche As String
 
 
Fichier = LCase(Fichier)
 
Rep_Recherche = Rep & "*.*" 'Contient le répertoire de recherche
 
'Initialisation de la recherche avec le chemin du répertoire à scruter.
Handle_Recherche = FindFirstFile(Rep_Recherche, WFD)
If Handle_Recherche = INVALID_HANDLE_VALUE Then
    'Cela signifie que la recherche ne peut se faire
'    MsgBox ("Erreur dans le chemin de recherche")
    Exit Function
End If
 
Suite_Recherche = 1
 
Do While Suite_Recherche <> 0
    DoEvents
    'Retourne le nb de caractères précédent celui de fin de chaîne.
    nb_car = lstrlen(WFD.cFileName)
    'Extrait les caractères valides
    FileName = LCase(Left(WFD.cFileName, nb_car))
    'Teste si c'est un répertoire
    If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
        'Vérifie si le nom du répertoire n'est pas le mère ou
        'l'enfant. (.. ou .)
        If (FileName <> "." And FileName <> "..") Then
            'Ajoute le répertoire à la liste de ceux scrutés.
'            ListDirectory.AddItem (Rep & FileName & "\")
            'Appel récursif pour recherche dans le nouveau
            'répertoire trouvé.
            If FileName <> "$recycle.bin" Then
                Call Fnc_Recherche_Repertoire_API(Rep & FileName & "\", Fichier)
            End If
        End If
    End If
 
    If FileName = Fichier Then
        If strRetour <> "" Then strRetour = strRetour & ";"
        strRetour = strRetour & (Rep & FileName)
    End If
    'Recherche le fichier suivant.
    'Si Suite_Recherche vaut 0 le répertoire est vide et l'on
    'quitte la fonction.
    Suite_Recherche = FindNextFile(Handle_Recherche, WFD)
 
Loop
'FindClose (Handle_Recherche)
Fnc_Recherche_Repertoire_API = strRetour
End Function

A noter qu'il faut lui préciser le disque de recherche

A utiliser dans la feuille avec une boucle sur la colonne A

Code :

1
2
3
4
5
6
7
8
9
10
Sub RechercheRep()
 
Dim i As Long
 
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    strRetour = ""
    Range("B" & i).Value = Fnc_Recherche_Repertoire_API("C:\", Range("A" & i).Value)
Next i
 
End Sub

Cette solution est fortement inspirée de cet exemple de micorosft :http://support.microsoft.com/kb/467457/fr

[redbull222]

Je vais tester