Set Travail = Application.FileSearch Excel 2013

Bonjour,

L'un de vous peut il m'aider pour adapter "Set Travail = Application.FileSearch" sur excel 2013 svp?

Merci,

Début de la VBA :

Sub OuvreFichiers()

Dim NomFichier As String, NomOnglet As String

Dim Cpt As Integer, CptJauge As Integer

Dim pctdone As Single

Dim FlagErreur As Boolean

Dim i%

FlagErreur = False

BarreAvant = Application.DisplayStatusBar 'Sauvegarde de l'état en cours de la barre d'état

Application.DisplayStatusBar = True 'Active l'affichage de la barre d'état

Application.StatusBar = "Importation en cours, merci de patienter..."

Application.ScreenUpdating = False 'On désactive l'affichage écran pour accélérer le traitement.

Sheets("TMP_Import").Visible = True 'Afficher l'onglet TMP_Import

Set Travail = Application.FileSearch

Travail.LookIn = Range("CheminCorbeille") 'Cellule nommée dans onglet "Conso Agence"

Travail.Filename = "*.xls"

With Travail

If .Execute > 0 Then

For i = 1 To .FoundFiles.Count

Application.StatusBar = "Importation du fichier " + .FoundFiles(i) + " en cours..."

Workbooks.Open (.FoundFiles(i)), 0, , , , , IgnoreReadOnlyRecommended

Bonjour,

ci-dessous une solution

Ajouter référence Microsoft Scripting Runtime

Sub OuvreFichiers()

Dim NomFichier As String, NomOnglet As String
Dim Cpt As Integer, CptJauge As Integer
Dim pctdone As Single
Dim FlagErreur As Boolean
Dim fso As New FileSystemObject          'Création classe gestion de fichiers
Dim dossier As Folder, fichier As File

FlagErreur = False
BarreAvant = Application.DisplayStatusBar 'Sauvegarde de l'état en cours de la barre d'état
Application.DisplayStatusBar = True 'Active l'affichage de la barre d'état
Application.StatusBar = "Importation en cours, merci de patienter..."
Application.ScreenUpdating = False 'On désactive l'affichage écran pour accélérer le traitement.
Sheets("TMP_Import").Visible = True 'Afficher l'onglet TMP_Import

With fso
    Set dossier = .GetFolder(Range("CheminCorbeille")) 'Cellule nommée dans onglet "Conso Agence"
     For Each fichier In dossier.Files
       If .GetExtensionName(fichier.Name) = "xls" Then
           Application.StatusBar = "Importation du fichier " + fichier.Name + " en cours..."
           Workbooks.Open (fichier.Path), 0, , , , , IgnoreReadOnlyRecommended
           '....
        End If
    Next fichier
End With

Bonjour Thev,

Merci pour votre aide.

Après essai, j'ai une erreur de compilation, variable de Next incorrect ( Next Fichier ),

Je vous joint le .bas cela sera sans doute plus simple pour vous de jeter un œil...

Merci à vous

Bonjour,

,fichier .bas non joint, oubli ?

Bonjour,

Désolé le .bas ne passe pas, ci joint en .ZIP ...

Merci,

Cette version devrait fonctionner

ne pas oublier d'ajouter la référence Microsoft Scripting Runtime.

Exact, la macro tourne mais tous les fichiers ne remontent pas... je vais vérifier les fichiers en question.

Merci beaucoup pour votre aide et votre réactivité.

Peut-être revoir le test sur l'extension du fichier

If .GetExtensionName(fichier.Name) = "xls" Then

comme ceci

If .GetExtensionName(fichier.Name) like "xls*" Then

afin de prendre en compte les .xlsx ou .xlsm