Macro non compatible sous Excel 2007 - fonction With Application.FileSearch

[Samferrir72]

Bonjour,

J'ai une macro dans un fichier excel 2007 qui ne fonctionne pas car la fonction With Application.FileSearch (fonction permettant de lister des fichiers) n'est pas disponible.

Principe de la macro :
- Des fichiers excel sont stockés sur un serveur dans un répertoire défini.
- La macro vient chercher les différents fichiers (suivant le chemin présent dans la cellule B5 du fichier excel), ouvre les fichiers et reportent de manière dynamique, ligne par ligne les informations présentes dans ces fichiers au sein d'un tableau de suivi.

Comment feriez vous pour l'adapter sans tout casser : macro ci dessous:
Les paramètres d'importation des données présents dans les fichiers sont décrits dans un autre module.

Option Explicit

' Nom des fichiers à prendre en compte (exemple : FA*.XLS)
Public Const cmstrNomFichierAno As String = "FA*.xls"

' Nb de lignes dans Excel
Private Const cmintNbMaxRow As Long = 65536

' Indice de la première ligne pour les fiches
Private Const cmint1ereLigneRow As Integer = 9

' Coordonnées de la cellule ou trouver le répertoire
Private Const cmintPathRow As Integer = 5
Private Const cmintPathCol As Integer = 2

' Coordonnées de la cellule ou inscrire la date de maj
Private Const cmintMajRow As Integer = 4
Private Const cmintMajCol As Integer = 5

Public Sub Miseajour()
Dim mshtMainSheet As Worksheet ' feuille principale
Dim i As Integer

' Mémorise la feuille principale
Set mshtMainSheet = ActiveSheet

' Initialisation
mshtMainSheet.Cells(cmintMajRow, cmintMajCol).Value = "Mise à jours en cours..."
Application.ScreenUpdating = False
mshtMainSheet.Rows(cmint1ereLigneRow & ":" & cmintNbMaxRow).Delete Shift:=xlUp ' Suppression des lignes

' permet de conserver le chemin absolue du répertoire des fiches anomalies

'permet de faire la liste des fichiers du répertoire des fiches anomalies
With Application.FileSearch
.LookIn = mshtMainSheet.Cells(cmintPathRow, cmintPathCol)
.Filename = cmstrNomFichierAno ' structure des noms des fiches anomalies doit être FAxxx permettra de lister toutes les fiches sans prendre en compte les fichiers annexes

If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then

For i = 1 To .FoundFiles.Count

' Informe l'utilisateur de l'avancée
Application.StatusBar = "Vérification en cours... " _
& Format(i * 100 / (.FoundFiles.Count + 1), "##0") & " %"

'Appel de procédure de remplissage du tableau mémoire
Call RempliTableau(.FoundFiles(i), mshtMainSheet.Rows(i + cmint1ereLigneRow - 1))

Next i
Application.StatusBar = ""
Else
MsgBox "Il n'y a pas de fiches anomalies dans le répertoire indiqué"
End If
End With

mshtMainSheet.Cells(cmintMajRow, cmintMajCol).Value = "MAJ le " & Date & " " & Time & " !"

Application.ScreenUpdating = True
Concatener
End Sub

 

[tototiti2008]

Re : Macro non compatible sous Excel 2007 - fonction With Application.FileSearch

Bonjour Samferrir,

peut-être ene remplaçant

With Application.FileSearch
.LookIn = mshtMainSheet.Cells(cmintPathRow, cmintPathCol)
.Filename = cmstrNomFichierAno ' structure des noms des fiches anomalies doit être FAxxx permettra de lister toutes les fiches sans prendre en compte les fichiers annexes
 
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
 
For i = 1 To .FoundFiles.Count
 
' Informe l'utilisateur de l'avancée
Application.StatusBar = "Vérification en cours... " _
& Format(i * 100 / (.FoundFiles.Count + 1), "##0") & " %"
 
'Appel de procédure de remplissage du tableau mémoire
Call RempliTableau(.FoundFiles(i), mshtMainSheet.Rows(i + cmint1ereLigneRow - 1))
 
Next i
Application.StatusBar = ""
Else
MsgBox "Il n'y a pas de fiches anomalies dans le répertoire indiqué"
End If
End With

par

Dim FSO, FD, FIC, i As Long, j As Long
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set FD = FSO.GetFolder(mshtMainSheet.Cells(cmintPathRow, cmintPathCol))
    j = 0
    i = 1
    For Each FIC In FD.Files
        Application.StatusBar = "Vérification en cours... " _
            & Format(i * 100 / (FD.Files.Count + 1), "##0") & " %"
        If UCase(FIC.Name) Like UCase(cmstrNomFichierAno) Then
            j = j + 1
            Call RempliTableau(FIC.Name, mshtMainSheet.Rows(i + cmint1ereLigneRow - 1))
        End If
        i = i + 1
    Next FIC
    Application.StatusBar = ""
    If j = 0 Then MsgBox "Il n'y a pas de fiches anomalies dans le répertoire indiqué"

mais les résultats ne seront pas triés comme avec l'original

 

[Samferrir72]

Re : Macro non compatible sous Excel 2007 - fonction With Application.FileSearch

merci beaucoup pour ta rapidité

ca marche, il manquait juste une p'tite partie du code dans l'appel de la procédure Call RempliTableau
Call RempliTableau(FD + "\" + [/I]FIC.Name, mshtMainSheet.Rows(ii + cmint1ereLigneRow - 1))
End If

Sam