Filesearch with excel 2007 et vb6
zouhir4net
Messages postés
2
Date d'inscription
mercredi 22 avril 2009
Statut
Membre
Dernière intervention
9 juin 2011
-
9 juin 2011 à 15:10
c148270 Messages postés 303 Date d'inscription mercredi 12 janvier 2005 Statut Membre Dernière intervention 3 octobre 2013 - 10 juin 2011 à 08:12
c148270 Messages postés 303 Date d'inscription mercredi 12 janvier 2005 Statut Membre Dernière intervention 3 octobre 2013 - 10 juin 2011 à 08:12
A voir également:
- Filesearch with excel 2007 et vb6
- Excel vba doevents - Conseils pratiques -Visual Basic / VB.NET
- Arctangente excel - Forum Visual Basic
- Excel vba modulo - Forum Visual Basic
- Tan-1 excel - Forum C++ & C++ .NET
- Inverse Sinus, Cos, et Tangent ✓ - Forum Visual Basic 6
3 réponses
sebmafate
Messages postés
4936
Date d'inscription
lundi 17 février 2003
Statut
Membre
Dernière intervention
14 février 2014
37
9 juin 2011 à 15:15
9 juin 2011 à 15:15
Post déplacé
Sébastien FERRAND
Ingénieur Concepteur Senior
Microsoft Visual C# MVP 2004 - 2009
Blog Photo
Sébastien FERRAND
Ingénieur Concepteur Senior
Microsoft Visual C# MVP 2004 - 2009
Blog Photo
Phiphi41
Messages postés
41
Date d'inscription
dimanche 23 mars 2008
Statut
Membre
Dernière intervention
16 août 2013
1
10 juin 2011 à 04:23
10 juin 2011 à 04:23
Bonjour
FileSearch a disparu, regardes là : Un complément FileSearch pour Excel 2007
FileSearch a disparu, regardes là : Un complément FileSearch pour Excel 2007
c148270
Messages postés
303
Date d'inscription
mercredi 12 janvier 2005
Statut
Membre
Dernière intervention
3 octobre 2013
1
10 juin 2011 à 08:12
10 juin 2011 à 08:12
Bonjour
En complément (VBA) :
Public Fichiertrouve
-----
Function Cherchefile()
retval = Cherchefichier("d:", "bd*.*")
If Fichiertrouve = True Then
a = 1
End If
End Function
--------
Function Cherchefichier(ByRef strDir As String, ByRef searchTerm As String)
Dim fso As Object
Dim strName As String
Dim strArr(1 To 65536, 1 To 1) As String, i As Long
On Error GoTo errr
Fichiertrouve = False
Let strName = Dir$(strDir & "\*" & searchTerm)
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = strDir & "" & strName
Let strName = Dir$()
Loop
Set fso = CreateObject("Scripting.FileSystemObject")
Call recurseSubFolders(fso.GetFolder(strDir), strArr(), i, searchTerm)
Set fso = Nothing
If i > 0 Then
Fichiertrouve = True
a strArr(i, 1) 'pour mémoire : strArr chemin du fichier
End If
Exit Function
errr:
If err.Number = 76 Then Resume Next ' répertoire inexistant
End Function
--------------
Private Sub recurseSubFolders(ByRef Folder As Object, _
ByRef strArr() As String, _
ByRef i As Long, _
ByRef searchTerm As String)
Dim SubFolder As Object
Dim strName As String
On Error GoTo errr
For Each SubFolder In Folder.SubFolders
Let strName = Dir$(SubFolder.Path & "\*" & searchTerm)
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = SubFolder.Path & "" & strName
If Mid(strArr(i, 1), Len(strArr(i, 1)) - (Len(searchTerm) - 1), Len(searchTerm)) Then
a = strArr(i, 1)
End If
Loop
Call recurseSubFolders(SubFolder, strArr(), i, searchTerm)
Next
Exit Sub
errr:
If err.Number 52 Then Resume Next '52 accès interdit
End Sub
Bonne journée
En complément (VBA) :
Public Fichiertrouve
-----
Function Cherchefile()
retval = Cherchefichier("d:", "bd*.*")
If Fichiertrouve = True Then
a = 1
End If
End Function
--------
Function Cherchefichier(ByRef strDir As String, ByRef searchTerm As String)
Dim fso As Object
Dim strName As String
Dim strArr(1 To 65536, 1 To 1) As String, i As Long
On Error GoTo errr
Fichiertrouve = False
Let strName = Dir$(strDir & "\*" & searchTerm)
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = strDir & "" & strName
Let strName = Dir$()
Loop
Set fso = CreateObject("Scripting.FileSystemObject")
Call recurseSubFolders(fso.GetFolder(strDir), strArr(), i, searchTerm)
Set fso = Nothing
If i > 0 Then
Fichiertrouve = True
a strArr(i, 1) 'pour mémoire : strArr chemin du fichier
End If
Exit Function
errr:
If err.Number = 76 Then Resume Next ' répertoire inexistant
End Function
--------------
Private Sub recurseSubFolders(ByRef Folder As Object, _
ByRef strArr() As String, _
ByRef i As Long, _
ByRef searchTerm As String)
Dim SubFolder As Object
Dim strName As String
On Error GoTo errr
For Each SubFolder In Folder.SubFolders
Let strName = Dir$(SubFolder.Path & "\*" & searchTerm)
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = SubFolder.Path & "" & strName
If Mid(strArr(i, 1), Len(strArr(i, 1)) - (Len(searchTerm) - 1), Len(searchTerm)) Then
a = strArr(i, 1)
End If
Loop
Call recurseSubFolders(SubFolder, strArr(), i, searchTerm)
Next
Exit Sub
errr:
If err.Number 52 Then Resume Next '52 accès interdit
End Sub
Bonne journée
