Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Application file.search sur Excel 2007

Application file.search sur Excel 2007

2 réponses
Avatar
Jean-Noel Robert
Bonjour,
Je transferre des macros VBA depuis Excel 2003 vers 2007. Globalement le
résultat est concluant, mis à part certaines applications telles que
File.search qui permet de remonter un fichier depuis un sous-répertoire en
fonction des premières lettres de son nom.

Exemple de code sous 2003 :

******************************************
'Lance une recherche de Tous les fichiers nommé PIC dans le repertoire des
Programmes
With Application.FileSearch
.NewSearch
.LookIn = vp_Chemin_PIC 'va chercher dans le répertoire et
sous répertoire de programme du Chemin
.SearchSubFolders = True 'permet de chercher dans les sous
répertoire
.Filename = "PIC_" 'le nom du fichier a chercher
.MatchTextExactly = True 'cherche les fichiers dont le corps
de texte ou les propriétés contiennent exactement le mot spécifié.
.FileType = msoFileTypeExcelWorkbooks 'Recherche que les fichiers
.xls
.Execute
If .Execute() = 0 Then
MsgBox "Attention, il n'y a aucun fihier PIC trouvé"
Exit Sub
End If
End With
******************************************


Nous avons trouvé sous 2007 un substitu de fonction qui s'appelle
ClFileSearch.xlam


******************************************
Option Explicit

Option Compare Text

Option Base 1





'-------------------------------------------------



'Module de classe ClasseFileSearch pour Excel 2007

'SilkyRoad

'http://silkyroad.developpez.com/

'

'

'Mise à jour le 01.07.2007



'-------------------------------------------------





'La procédure recherche des fichiers en fonction des critères

'spécifiés et renvoie dans un tableau :



'Le nom des fichiers

'Le chemin

'La taille des fichers (en octets)

'La date de création

'La date de dernière modification

'Le type de fichier)





'-------------------------------------------------





'Enumération pour les options de tri

Public Enum Sort_By

Sort_None

sort_Name

sort_Path

sort_Size

sort_DateCreated

sort_LastModified

sort_Type

End Enum





Dim TabFiles() As InfosResultFichiers

Dim DirectoryPath As String

Dim lngFoundFilesCount As Long

Dim boolSousRep As Boolean

Dim strExtens As String

Dim optionSortBy As Long







'Propriété pour le répertoire de recherche

Public Property Let FolderPath(strFolderPath As String)

DirectoryPath = strFolderPath

End Property





'Propriété pour rechercher dans les sous dossiers

Public Property Let SubFolders(boolSubFolders As Boolean)

boolSousRep = boolSubFolders

End Property





'Propriété pour lister les fichiers correspondants à la requête

Public Property Get Files(Idx As Long) As InfosResultFichiers

Files = TabFiles(Idx)

End Property





'Propriété pour l'extension des fichiers à rechercher

Public Property Let Extension(strExtension As String)

strExtens = strExtension

End Property





'Propriété pour compte le nombre de fichiers

Public Property Get FoundFilesCount() As Long

FoundFilesCount = lngFoundFilesCount

End Property





'Propriété pour l'option de tri

Public Property Let SortBy(lngSortBy As Sort_By)

optionSortBy = lngSortBy

End Property





'Fonction d'exécution

Public Function Execute() As Long

'Lance la recherche

ListeFichiers DirectoryPath



'Vérifie que des fichiers ont été trouvés et qu'une option de tri a

'été spécifié avant de lancer la procédure de tri.

If lngFoundFilesCount > 1 And optionSortBy <> Sort_By.Sort_None Then _

FonctionTri optionSortBy



Execute = lngFoundFilesCount

End Function







'Procédure pour lister les fichiers

Private Sub ListeFichiers(strFolderName As String)

Dim Fso As Object

Dim NomDossier As Object, SousDossier As Object

Dim objFichier As Object



On Error GoTo Fin





'Vérifie si le dossier spécifié existe

If Dir(strFolderName, vbDirectory Or vbHidden Or vbSystem) = "" Then
Exit Sub



Set Fso = CreateObject("Scripting.FileSystemObject")

Set NomDossier = Fso.GetFolder(strFolderName)





'Boucle sur les fichiers du répertoire

For Each objFichier In NomDossier.Files



'Vérifie l'extension du fichier

If objFichier.Name Like strExtens Or strExtens = "" Then



'Redimensionne le tableau pour ajouter un nouvel élément

lngFoundFilesCount = lngFoundFilesCount + 1

ReDim Preserve TabFiles(lngFoundFilesCount)



'Nom fichier

TabFiles(lngFoundFilesCount).strFileName = objFichier.Name

'Répertoire

TabFiles(lngFoundFilesCount).strPathName =
objFichier.ParentFolder

'Taille du fichier (en octets)

TabFiles(lngFoundFilesCount).lngSize = objFichier.Size

'Date de création

TabFiles(lngFoundFilesCount).DateCreated =
objFichier.DateCreated

'Date de création ou dernière modification

TabFiles(lngFoundFilesCount).DateLastModified =
objFichier.DateLastModified

'Type de fichier

TabFiles(lngFoundFilesCount).strFileType = objFichier.Type

End If

Next objFichier





'Boucle récursive:

'(Si l'option de recherche dans les sous répertoires a été spécifiée)

If boolSousRep Then

For Each SousDossier In NomDossier.SubFolders

ListeFichiers SousDossier.Path

Next SousDossier

End If





Exit Sub:



Fin:

MsgBox "Erreur '" & Err.Number & "'" & vbCrLf & vbCrLf & _

Err.Description, vbInformation

End Sub







'Procédure de tri (reste à améliorer).

Private Sub FonctionTri(optionSortBy As Sort_By)

Dim i As Long, j As Long, k As Long

Dim ValTemp As Variant



'Vérifie quel champ du tableau doit être trié

Select Case optionSortBy



Case Sort_By.sort_Name

For i = LBound(TabFiles) To UBound(TabFiles)

j = i

For k = j + 1 To UBound(TabFiles)

If TabFiles(k).strFileName <= TabFiles(j).strFileName
Then j = k

If TabFiles(k).strFileName <= TabFiles(j).strFileName
Then j = k

Next k



If i <> j Then

ValTemp = TabFiles(j).strFileName:
TabFiles(j).strFileName = _

TabFiles(i).strFileName: TabFiles(i).strFileName =
ValTemp



ValTemp = TabFiles(j).strPathName:
TabFiles(j).strPathName = _

TabFiles(i).strPathName: TabFiles(i).strPathName =
ValTemp



ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _

TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp



ValTemp = TabFiles(j).DateCreated:
TabFiles(j).DateCreated = _

TabFiles(i).DateCreated: TabFiles(i).DateCreated =
ValTemp



ValTemp = TabFiles(j).DateLastModified:
TabFiles(j).DateLastModified = _

TabFiles(i).DateLastModified:
TabFiles(i).DateLastModified = ValTemp



ValTemp = TabFiles(j).strFileType:
TabFiles(j).strFileType = _

TabFiles(i).strFileType: TabFiles(i).strFileType =
ValTemp

End If

Next i





Case Sort_By.sort_Path

For i = LBound(TabFiles) To UBound(TabFiles)

j = i

For k = j + 1 To UBound(TabFiles)

If TabFiles(k).strPathName <= TabFiles(j).strPathName
Then j = k

If TabFiles(k).strPathName <= TabFiles(j).strPathName
Then j = k

Next k



If i <> j Then

ValTemp = TabFiles(j).strFileName:
TabFiles(j).strFileName = _

TabFiles(i).strFileName: TabFiles(i).strFileName =
ValTemp



ValTemp = TabFiles(j).strPathName:
TabFiles(j).strPathName = _

TabFiles(i).strPathName: TabFiles(i).strPathName =
ValTemp



ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _

TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp



ValTemp = TabFiles(j).DateCreated:
TabFiles(j).DateCreated = _

TabFiles(i).DateCreated: TabFiles(i).DateCreated =
ValTemp



ValTemp = TabFiles(j).DateLastModified:
TabFiles(j).DateLastModified = _

TabFiles(i).DateLastModified:
TabFiles(i).DateLastModified = ValTemp



ValTemp = TabFiles(j).strFileType:
TabFiles(j).strFileType = _

TabFiles(i).strFileType: TabFiles(i).strFileType =
ValTemp

End If

Next i





Case Sort_By.sort_Size

For i = LBound(TabFiles) To UBound(TabFiles)

j = i

For k = j + 1 To UBound(TabFiles)

If TabFiles(k).lngSize <= TabFiles(j).lngSize Then j = k

If TabFiles(k).lngSize <= TabFiles(j).lngSize Then j = k

Next k



If i <> j Then

ValTemp = TabFiles(j).strFileName:
TabFiles(j).strFileName = _

TabFiles(i).strFileName: TabFiles(i).strFileName =
ValTemp



ValTemp = TabFiles(j).strPathName:
TabFiles(j).strPathName = _

TabFiles(i).strPathName: TabFiles(i).strPathName =
ValTemp



ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _

TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp



ValTemp = TabFiles(j).DateCreated:
TabFiles(j).DateCreated = _

TabFiles(i).DateCreated: TabFiles(i).DateCreated =
ValTemp



ValTemp = TabFiles(j).DateLastModified:
TabFiles(j).DateLastModified = _

TabFiles(i).DateLastModified:
TabFiles(i).DateLastModified = ValTemp



ValTemp = TabFiles(j).strFileType:
TabFiles(j).strFileType = _

TabFiles(i).strFileType: TabFiles(i).strFileType =
ValTemp

End If

Next i





Case Sort_By.sort_DateCreated

For i = LBound(TabFiles) To UBound(TabFiles)

j = i

For k = j + 1 To UBound(TabFiles)

If TabFiles(k).DateCreated <= TabFiles(j).DateCreated
Then j = k

If TabFiles(k).DateCreated <= TabFiles(j).DateCreated
Then j = k

Next k



If i <> j Then

ValTemp = TabFiles(j).strFileName:
TabFiles(j).strFileName = _

TabFiles(i).strFileName: TabFiles(i).strFileName =
ValTemp



ValTemp = TabFiles(j).strPathName:
TabFiles(j).strPathName = _

TabFiles(i).strPathName: TabFiles(i).strPathName =
ValTemp



ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _

TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp



ValTemp = TabFiles(j).DateCreated:
TabFiles(j).DateCreated = _

TabFiles(i).DateCreated: TabFiles(i).DateCreated =
ValTemp



ValTemp = TabFiles(j).DateLastModified:
TabFiles(j).DateLastModified = _

TabFiles(i).DateLastModified:
TabFiles(i).DateLastModified = ValTemp



ValTemp = TabFiles(j).strFileType:
TabFiles(j).strFileType = _

TabFiles(i).strFileType: TabFiles(i).strFileType =
ValTemp

End If

Next i





Case Sort_By.sort_LastModified

For i = LBound(TabFiles) To UBound(TabFiles)

j = i

For k = j + 1 To UBound(TabFiles)

If TabFiles(k).DateLastModified <=
TabFiles(j).DateLastModified Then j = k

If TabFiles(k).DateLastModified <=
TabFiles(j).DateLastModified Then j = k

Next k



If i <> j Then

ValTemp = TabFiles(j).strFileName:
TabFiles(j).strFileName = _

TabFiles(i).strFileName: TabFiles(i).strFileName =
ValTemp



ValTemp = TabFiles(j).strPathName:
TabFiles(j).strPathName = _

TabFiles(i).strPathName: TabFiles(i).strPathName =
ValTemp



ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _

TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp



ValTemp = TabFiles(j).DateCreated:
TabFiles(j).DateCreated = _

TabFiles(i).DateCreated: TabFiles(i).DateCreated =
ValTemp



ValTemp = TabFiles(j).DateLastModified:
TabFiles(j).DateLastModified = _

TabFiles(i).DateLastModified:
TabFiles(i).DateLastModified = ValTemp



ValTemp = TabFiles(j).strFileType:
TabFiles(j).strFileType = _

TabFiles(i).strFileType: TabFiles(i).strFileType =
ValTemp

End If

Next i



Case Sort_By.sort_Type

For i = LBound(TabFiles) To UBound(TabFiles)

j = i

For k = j + 1 To UBound(TabFiles)

If TabFiles(k).strFileType <= TabFiles(j).strFileType
Then j = k

If TabFiles(k).strFileType <= TabFiles(j).strFileType
Then j = k

Next k



If i <> j Then

ValTemp = TabFiles(j).strFileName:
TabFiles(j).strFileName = _

TabFiles(i).strFileName: TabFiles(i).strFileName =
ValTemp



ValTemp = TabFiles(j).strPathName:
TabFiles(j).strPathName = _

TabFiles(i).strPathName: TabFiles(i).strPathName =
ValTemp



ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _

TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp



ValTemp = TabFiles(j).DateCreated:
TabFiles(j).DateCreated = _

TabFiles(i).DateCreated: TabFiles(i).DateCreated =
ValTemp



ValTemp = TabFiles(j).DateLastModified:
TabFiles(j).DateLastModified = _

TabFiles(i).DateLastModified:
TabFiles(i).DateLastModified = ValTemp



ValTemp = TabFiles(j).strFileType:
TabFiles(j).strFileType = _

TabFiles(i).strFileType: TabFiles(i).strFileType =
ValTemp

End If

Next i

End Select

End Sub

******************************************

Un grand merci par avance à celui qui aurait une idée pour résoudre ce
problème

Cordialement,

Jean-Noël
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
isabelle
bonjour Jean-Noel,

FileSearch n'est plus disponible pour Office2007.
suis ce lien pour plus d'info
http://silkyroad.developpez.com/vba/classefilesearch/

isabelle

Le 2010-07-21 09:55, Jean-Noel Robert a écrit :
Bonjour,
Je transferre des macros VBA depuis Excel 2003 vers 2007. Globalement le
résultat est concluant, mis à part certaines applications telles que
File.search qui permet de remonter un fichier depuis un sous-répertoire en
fonction des premières lettres de son nom.

Jean-Noël
Avatar
DanielCo
Bonjour.
Il y a des addins sur internet qui remplacent cette méthode plus ou
moins fiable. Sinon, voici un exemple de code pour trouver et lister
sur la feuille active tous les fichiers xlsx dans un dossier et tous
les sous-dossiers dépendants :

Public Ctr As Long, f As Object, d As Object
Sub test()
Dim DossierRacine As String, FSO As Object, Dossier As Object
Application.ScreenUpdating = False
DossierRacine = "d:donneesdaniel" 'Dossier ou se fait la recherche
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dossier = FSO.getfolder(DossierRacine)
ChercheDossier Dossier
Application.ScreenUpdating = True
End Sub
Sub ChercheDossier(Dossier)
For Each f In Dossier.Files
If LCase(Right(f, 4)) = "xlsx" Then
Ctr = Ctr + 1
Cells(Ctr, 1) = f.Path
End If
Next
For Each d In Dossier.subfolders
ChercheDossier d
Next d
End Sub

Cordialement.
Daniel