Nouveau code pour "Application.FileSearch"

[marmotte18]

Bonjour,

Dans Excel 2003, j'avais une macro qui fonctionnait fort bien et qui utilisait le code suivant :

With Application.FileSearch   
    .LookIn = Dossier
    .SearchSubFolders = True
End With

Avec Excel 2010, ma macro ne fonctionne plus et se bloque sur "With Application.File Search" avec le message "Erreur d'exécution 445 - Cet objet ne gère pas cette action".

Comment faut-il maintenant écrire le code sous Excel 2010 ?

Merci par avance

 

[YANN-56]

Re : Nouveau code pour "Application.FileSearch"

Bonsoir JNP, et à tous,

Je ne sais si tu répondais à Marmotte ou à moi... (Le me le fait supposer)

En tous les cas; Merci pour ton code que je vais certainement suivre.
Il fonctionne à merveille, et je vais pouvoir facilement l'adapter à mes caprices.

Il me reste à savoir si cette boite de dialogue est toujours valable pour 2010:

' ======  RECHERCHE DES DOSSIERS
Set RECHERCHE = Application.FileDialog(msoFileDialogFolderPicker)
 With RECHERCHE
    .Title = "     CHOISIR UN DOSSIER"
    .AllowMultiSelect = False
        If .Show = -1 Then
           For Each CHOIXDOSSIER In .SelectedItems
           DOSSIER_CHOISI = CHOIXDOSSIER & "\"
           Next CHOIXDOSSIER
        End If
  End With
Set RECHERCHE = Nothing
' If DOSSIER_CHOISI <> "" Then ……………

Peut-être devrais-je ouvrir une question spécifique à ce sujet?

A nouveau Merci pour ton aide, et bonne soirée.
Diantre! C'est quand que je serai aussi doué???

Amicalement.

Yann

 

[marmotte18]

Re : Nouveau code pour "Application.FileSearch"

Bonsoir tout le monde,

Un grand merci à ceux qui m'ont aidé et qui m'ont permis de fabriquer l'utilitaire ci-joint.

Une pensée toute particulière pour JNP qui a été particulièrement patient et accrocheur.

KJIN : bravo aussi pour ta solution qui amène les mêmes enregistrements que JNP et que ceux de l'utilitaire annoncé.

Modification apportée à l'utilitaire le 01/12/2010 :

J'y ai rajouté l'attribut des fichiers (normal, lecture seule, fichier caché, caché en lecture seule)

 

[YANN-56]

Re : Nouveau code pour "Application.FileSearch"

Bonsoir marmotte, et à tous,

Indirectement tu viens de me montrer que:

Application.FileDialog(msoFileDialogFolderPicker)

Fonctionne chez toi, donc en version 2010.

Merci à toi d'avoir répondu à ma question.

Pour le reste, tu étais entre de telles bonnes mains
que la réussite ne pouvait être qu'au bout du chemin.

Amicalement.

Yann.

 

[marmotte18]

Re : Nouveau code pour "Application.FileSearch"

Bonjour tout le monde,

Ci-joint l'utilitaire finalisé de listage des fichiers. J'y ai rajouté les dates de création et de dernière modification. Les attributs sont également complètement décodifiés.

 

[VIARD]

Re : Nouveau code pour "Application.FileSearch"

Bonjour à tous

Je réactive le fil, du à la nécessité du moment.
j'ai bien suivi les différents messages. Et de mon côté j'ai effectué quelques tests.
Utilisant excel 2000, certaines fonctions ne me sont pas permises.

Tel Application.FileDialog(msoFileDialogFolderPicker)

Si bien qu'en mixant tout ça, j'ai créé un utilitaire qui j'espère rendra service.
Après tout, c'est un juste retour des choses, j'apprends et je retourne le tout emballé.

fichier joint
Salutation à tous
Jean-PaulRegarde la pièce jointe DosFich.zip

 

[Nurbo]

Re : Nouveau code pour "Application.FileSearch"

Salut,


Je suis aussi dans le même cas, changement de version la semaine dernière, je m'attendais à avoir des problèmes avec les macros, mais je m'attendais pas à ce qu'une instruction soit complètement supprimée !!!

J4ai tout de même lu tout le fil, j'ai installé le complement qui est bien reconnu ( ClFileSearch) mais je n'arrive pas à faire exactement ce que me faisait l'ancienne macro dont voici le code :

Sub alimenter_jour()

Dim D As String, M As String, Y As String
Dim K As Integer
Dim Travail As Variant

    Application.ScreenUpdating = False
    Sheets("jour").Select

' recupère le Day Month Year de la celulle active de la feuille Jour
    D = Left(ActiveCell, 2)
    M = Mid(ActiveCell, 4, 2)
    Y = Right(ActiveCell, 2)
    K = ActiveCell.Row

    Set Travail = Application.FileSearch
    With Travail

' recherche dans le dossier "fiches" un fichier xls qui va correspondre aux variables D-M-Y récuperées plus haut
        .LookIn = "R:\retards\Retards colis\fiches"
        .Filename = "retards " & D & M & Y & ".xls"

' je ne comprend pas cette instruction
        If .Execute > 0 Then

' ouvre le fichier correspondant aux variables D-M-Y
            Workbooks.Open Filename:= _
                "R:\retards\Retards colis\fiches\retards " & D & M & Y & ".xls", _
                UpdateLinks:=False

' ce qui suit test si la fiche existe pour la journée séléectionnée, mais je peux m'en passer
        Else
            ActiveCell.Interior.ColorIndex = 4
            If Now < ActiveCell Then
                MsgBox "cette fiche n'existe pas encore !", , "Retards colis"
                Exit Sub
            Else
                MsgBox "cette fiche n'existe pas ", , "Retards colis"
                ActiveCell.Offset(6, 0).Select
                Exit Sub
            End If
        End If
    End With

Ce code ce n'est pas moi qui l'ai écrit, mais une ancienne collègue.


Avec le complement ClFileSearch j'arrive a rentrer dans le dossier voulu, mais je bug sur l'ouverture du fichier retards Day-Mounth-Year.xls (exemple: retards 111212.xls pour aujourd'hui)


Je suis désolé, mais je ne vais pas pouvoir mettre de fichier exemple (ce n'est évidement pas des retards de colis que je comptabilise....)

Pour ma part mon début de code avec la mofif pour ClFilesSearch:

Sub alimenter_jour()

Dim D As String, M As String, Y As String
Dim K As Integer
Dim Travail As ClFileSearch.ClasseFileSearch
    Application.ScreenUpdating = False
    Sheets("jour").Select

' recupère le Day Month Year de la celulle active de la feuille Jour
    D = Left(ActiveCell, 2)
    M = Mid(ActiveCell, 4, 2)
    Y = Right(ActiveCell, 2)
    K = ActiveCell.Row

    Set Travail = ClFileSearch.Nouvelle_Recherche
    With Travail

' recherche dans le dossier "fiches" un fichier xls qui va correspondre aux variables D-M-Y récuperées plus haut
        .FolderPath= "R:\retards\Retards colis\fiches"
' je ne sais pas comment interpreter "FileName" avec ClFileSearch
        .Filename = "retards " & D & M & Y & ".xls"

' je ne comprend pas cette instruction
        If .Execute > 0 Then

' ouvre le fichier correspondant aux variables D-M-Y
            Workbooks.Open Filename:= _
                "R:\retards\Retards colis\fiches\retards " & D & M & Y & ".xls", _
                UpdateLinks:=False

' ce qui suit test si la fiche existe pour la journée séléectionnée, mais je peux m'en passer
        Else
            ActiveCell.Interior.ColorIndex = 4
            If Now < ActiveCell Then
                MsgBox "cette fiche n'existe pas encore !", , "Retards colis"
                Exit Sub
            Else
                MsgBox "cette fiche n'existe pas ", , "Retards colis"
                ActiveCell.Offset(6, 0).Select
                Exit Sub
            End If
        End If
    End With

Merci !

Edit : Je suis sous 2010

 

[Nurbo]

Re : Nouveau code pour "Application.FileSearch"

salut,


Merci de ne pas m'avoir répondu, ça m'a permis de chercher.....et de trouver

C'était pourtant tout bidon et j'en étais vraiment pas loin.

Sub alimenter_jour()

Dim D As String, M As String, Y As String
Dim K As Integer
Dim Travail As ClFileSearch.ClasseFileSearch
    Application.ScreenUpdating = False
    Sheets("jour").Select

' recupère le Day Month Year de la celulle active de la feuille Jour
    D = Left(ActiveCell, 2)
    M = Mid(ActiveCell, 4, 2)
    Y = Right(ActiveCell, 2)
    K = ActiveCell.Row

    Set Travail = ClFileSearch.Nouvelle_Recherche
    With Travail

' recherche dans le dossier "fiches" un fichier xls qui va correspondre aux variables D-M-Y récuperées plus haut
        .FolderPath= "R:\retards\Retards colis\fiches"
' je ne sais pas comment interpreter "FileName" avec ClFileSearch
' edit : FileName = Extension
        .Extension = "retards " & D & M & Y & ".xls"

        If .Execute > 0 Then

' ouvre le fichier correspondant aux variables D-M-Y
            Workbooks.Open Filename:= _
                "R:\retards\Retards colis\fiches\retards " & D & M & Y & ".xls", _
                UpdateLinks:=False

' ce qui suit test si la fiche existe pour la journée séléectionnée, mais je peux m'en passer
        Else
            ActiveCell.Interior.ColorIndex = 4
            If Now < ActiveCell Then
                MsgBox "cette fiche n'existe pas encore !", , "Retards colis"
                Exit Sub
            Else
                MsgBox "cette fiche n'existe pas ", , "Retards colis"
                ActiveCell.Offset(6, 0).Select
                Exit Sub
            End If
        End If
    End With

En fait je ne trouvais pas l'équivalent de FileName dans ClFileSearch, chose que j'ai maintenant trouvé.
FileName = Extension

Et depuis cette modification, tout marche à merveille !


@+

 

[stephanlaunay@canl.nc]

Re : Nouveau code pour "Application.FileSearch"

Bonjour à tous,

On vient d'installer sur mon poste de travail Excel 2016, alors que nous étions sous Excel 2003. Bien entendu mes macros ne fonctionnent plus car j'utilise la procédure With Application.Filesearch qui me renvoi le code erreur 445.
Si j'ai bien suivi toutes les discutions précédentes, je dois utiliser la macro complémentaire ClFileSearch.ClasseFileSearch.

Comment l'active t-on ? Vous aurez certainement compris que je ne suis pas un expert.

Voici un extrait d mon programme.

Directory = "S:\Arc\" & A & "\" & Mes 'Directory = répertoire dans S: selon année sélectionnée
fichA = "ENE_NEP_MOY_10_MIN_" & A & M 'fichA = Début nom fichier pour les compter

r = 1
Cells(r, 1) = ""
Range("A1:C1").Font.Bold = True
r = r + 1

With Application.FileSearch
.NewSearch
.LookIn = Directory
.Filename = fichA & "*.*"
.SearchSubFolders = False
.Execute

Feuil5.Select

For i = 1 To .FoundFiles.Count
Cells(r, 1) = .FoundFiles(i)

r = r + 1
Next i
n = .FoundFiles.Count 'la variable n prend la valeur du nombre de fichier
End With
For K = 1 To n

Merci de votre collaboration.

Stephan

 

[stephanlaunay@canl.nc]

Re : Nouveau code pour "Application.FileSearch"

Bonjour à tous,

On vient d'installer sur mon poste de travail Excel 2016, alors que nous étions sous Excel 2003. Bien entendu mes macros ne fonctionnent plus car j'utilise la procédure With Application.Filesearch qui me renvoi le code erreur 445.
Si j'ai bien suivi toutes les discutions précédentes, je dois utiliser la macro complémentaire ClFileSearch.ClasseFileSearch.

Comment l'active t-on ? Vous aurez certainement compris que je ne suis pas un expert.

Voici un extrait d mon programme.

Directory = "S:\Arc\" & A & "\" & Mes 'Directory = répertoire dans S: selon année sélectionnée
fichA = "ENE_NEP_MOY_10_MIN_" & A & M 'fichA = Début nom fichier pour les compter

r = 1
Cells(r, 1) = ""
Range("A1:C1").Font.Bold = True
r = r + 1

With Application.FileSearch
.NewSearch
.LookIn = Directory
.Filename = fichA & "*.*"
.SearchSubFolders = False
.Execute

Feuil5.Select

For i = 1 To .FoundFiles.Count
Cells(r, 1) = .FoundFiles(i)

r = r + 1
Next i
n = .FoundFiles.Count 'la variable n prend la valeur du nombre de fichier
End With
For K = 1 To n

Merci de votre collaboration.

Stephan

Bonjour à tous,

J'ai envoyé le message ci-dessus sans m'être identifier, c'est peut être la raison pour laquelle je n'ai pas eu de réponse.

Je ne sais pas comment activer les macros complémentaires dans Excel 2016 "ClFileSearch.ClasseFileSearch"

Merci d'avance pour votre aide.

Stéphan

 

[MJ13]

Re : Nouveau code pour "Application.FileSearch"

Bonjour Stephan

Regarde peut-être ici:

https://www.excel-downloads.com/threads/classefilesearch-pour-excel2007.77650/

 

[stephanlaunay@canl.nc]

Re : Nouveau code pour "Application.FileSearch"

Bonjour Stephan

Regarde peut-être ici:

https://www.excel-downloads.com/threads/classefilesearch-pour-excel2007.77650/

Bonjour MJ13, L'application classefilesearch ne fonctionne plus sur Excel 2016. Elle n'est plus prise en compte depuis Excel 2010

Je recherche une procédure avec fso FileSystemObject qu pourrai s'adapter à mon programme et qui compterai aussi les fichiers

trouver. J'espère que FoundFiles.Count fonctionne toujours avec la version 2016.

Encore un grand MERCI pour ton aide.

Joyeuses fêtes de fin d'anée.

Stéphan

 

[MJ13]

Re : Nouveau code pour "Application.FileSearch"

Re

Pour compter les fichiers dans un dossier, tu peux utiliser la fonction Dir et faire un compteur, sinon, maintenant on utilise le Scripting.FileSystemObject.

Regarde le lien sous ma signature (My Sauvegarde), avec le click droit, tu peux compter et avoir la totalité du nombre de fichiers d'un dossier et sous-dossier ainsi que leur taille.

 

[Dranreb]

Re : Nouveau code pour "Application.FileSearch"

Bonjour.

En cochant la référence "Microsoft Scripting Runtime" (moi je la coche systématiquement dans tous mes classeur comme une référence incontournable, je ne veux même plus savoir si j'en ai vraiment besoin ou pas) et en évitant partout le type Object (utiliser à la place FileSystemObject, Folder, File et, dans un autre cadre d'utilisation, Dictionary), vous vous en faciliterez la programmation, car toutes les méthodes et propriétés de ces objets vous seront proposées dans une liste dès la frappe d'un point derrière leurs noms.

 

[stephanlaunay@canl.nc]

Re : Nouveau code pour "Application.FileSearch"

Bonjour MJ13,

J'ai écrit un programme test qui ne fonctionne pas. En effet il reconnait mon chemin mais bloc pour trouver les fichiers à lister et compter. Voici ce que j'ai écrit :


Mon chemin est le suivant :
Lecteur réseau S:\
Répertoire Archive : ARC
Sous répertoire Année : 2015
Sous répertoire dans 2015 (décembre) : 12_dec
Je souhaite par exemple lister les fichiers de chaque jour du mois de décembre nommés :
ENE_BLI_MOY_10_20151201.d01 (2015= année, 12 = mois, 01= jour)
ENE_BLI_MOY_10_20151202.d01
Dans le sous répertoire de décembre : 12_dec
il existe beaucoup d’autre fichiers commençant par
ENE_NEP_MOY_......................d01 ou
ENE_KMC_MOY_......................d01 ou
ENE_TEM_MOY_......................d01 etc…
pour lesquels il peut exister 31 fichiers (1 par jour) en fonction du mois.

Sub test()
Dim i As Long
Dim Rep As String, Dossier As Object, SousDossier As Object, fichier As Object
chemin = "S:\Arc\" & 2015 & "\" & "11_nov" 'Directory = répertoire dans S: selon année sélectionnée
fichier = "ENE_BLI_MOY_10_MIN_201511" & "*.*" 'fichD & "*.*"
Rep = chemin & "\" & fichD
i = 2
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(chemin)

For Each fichier In SousDossier.Files
Cells(i, 1) = SousDossier.Name
Cells(i, 2) = fichier.Name
i = i + 1
Next
End Sub

Merci de ton aide.

Meilleurs voeux pour 2016.

Stéphan

 

[stephanlaunay@canl.nc]

Re : Nouveau code pour "Application.FileSearch"

Bonjour Dranreb,

Merci pour votre aide.

J'ai coché la référence "Microsoft Scripting Runtime" qui n'était pas activée.

Toutefois mon programme test ne fonctionne pas. Vous l'avez certainement déjà compris " Je ne suis pas un expert. "

Voici plus explicitement ce que j'ai écris et aussi adressé à MJ13.


Mon chemin est le suivant :
Lecteur réseau S:\
Répertoire Archive : ARC
Sous répertoire Année : 2015
Sous répertoire dans 2015 (décembre) : 12_dec
Je souhaite par exemple lister les fichiers de chaque jour du mois de décembre nommés :
ENE_BLI_MOY_10_20151201.d01 (2015= année, 12 = mois, 01= jour)
ENE_BLI_MOY_10_20151202.d01
Dans le sous répertoire de décembre : 12_dec
il existe beaucoup d’autre fichiers commençant par
ENE_NEP_MOY_......................d01 ou
ENE_KMC_MOY_......................d01 ou
ENE_TEM_MOY_......................d01 etc…
pour lesquels il peut exister 31 fichiers (1 par jour) en fonction du mois.

Sub test()
Dim i As Long
Dim Rep As String, Dossier As Object, SousDossier As Object, fichier As Object
chemin = "S:\Arc\" & 2015 & "\" & "11_nov" 'Directory = répertoire dans S: selon année sélectionnée
fichier = "ENE_BLI_MOY_10_MIN_201511" & "*.*" 'fichD & "*.*"
Rep = chemin & "\" & fichier
i = 2
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Rep)

For Each fichier In SousDossier.Files
Cells(i, 1) = SousDossier.Name
Cells(i, 2) = fichier.Name
i = i + 1
Next
End Sub

Merci d'avance pour votre aide.

Meilleurs voeux pour 2016.

Stéphan