Plus rapide

[WDAndCo]

Bonjour le Forum

J'ai ce code qui vérifie le nombre de Classeurs dans un Dossier (plus de 5500)

Option Explicit
Private Sub Workbook_Open()
Application.ScreenUpdating = 0
 
    Dim fCount As Long
    Dim sPath As String
    Dim Tmp As String
    Dim FolderFiles() As Variant
    
  sPath = ThisWorkbook.Path & "\Fiche MP\"
  fCount = 0
  Tmp = Dir(sPath & "*.*")
  While Tmp <> Empty
    fCount = fCount + 1
    ReDim Preserve FolderFiles(1 To fCount)
    FolderFiles(fCount) = Tmp
    Tmp = Dir
  Wend
  
  If Cells(1, 28).Value = fCount Then NonFiltre: Exit Sub
  
Call ListeTablo

End Sub

Si le nombre est changé il execute une Macro qui mets les noms de Classeurs en tableau.

Est il possible de rendre ce Code plus rapide ?
Si oui comment ?
Quel est nombre maxi de Classeur dans un Dossier ?

 

[MichD]

Re : Plus rapide

Bonjour,

Voici un code élaborer par Laurent Longre utilisant les API de Windows

Cette procédure liste tous les fichiers du répertoire et de ses sous-répertoires
dans la feuille active du classeur.

Est-elle plus rapide, à toi de nous le dire!

Option Compare Text

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * 260
  cAlternate As String * 14
End Type

Private Declare Function FindFirstFileA Lib "Kernel32" _
  (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindNextFileA Lib "Kernel32" _
  (ByVal hFindfile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib "Kernel32" _
  (ByVal hFindfile As Long) As Long

Const Masque = "*.*" 'à définir

Dim Arr() As String
Dim NbFichiers As Long
Dim FileFindData As WIN32_FIND_DATA
Dim Fichier As String

Sub Test()
  ReDim Arr(1 To 1)
  NbFichiers = 0
  Recurse "c:\Users\Ton profil\Documents\"
  Application.ScreenUpdating = False
  With Range("A1").Resize(NbFichiers)
    .Value = Application.Transpose(Arr)
    .Sort [A1]
    .EntireColumn.AutoFit
  End With
End Sub

Private Sub Recurse(ByVal Chemin As String)
  Dim hFindfile As Long
  hFindfile = FindFirstFileA(Chemin & "*.*", FileFindData)
  If Chemin <> "D:\" Then
    FindNextFileA hFindfile, FileFindData
    If FindNextFileA(hFindfile, FileFindData) = 0 Then
      FindClose hFindfile
      Exit Sub
    End If
  End If
  Do
    Fichier = Chemin & Left$(FileFindData.cFileName, _
      InStr(1, FileFindData.cFileName, vbNullChar) - 1)
    If GetAttr(Fichier) And vbDirectory Then
      Recurse Fichier & "\"
    ElseIf Fichier Like Masque Then
      NbFichiers = NbFichiers + 1
      ReDim Preserve Arr(1 To NbFichiers)
      Arr(NbFichiers) = Fichier
    End If
  Loop While FindNextFileA(hFindfile, FileFindData)
  FindClose hFindfile
End Sub

 

[WDAndCo]

Re : Plus rapide

Bonjour le Forum

Merci MichD pour ce code, mais je veux juste faire une comparaison que le nombre de Classeur en mémoire est le nombre réel dans ce Dossier. Pour eviter de lancer une Marco qui prends un certain temps.
Je mets quand même de cote au cas ou.

 

[MichD]

Re : Plus rapide

juste faire une comparaison que le nombre de Classeurs en mémoire est le nombre réel dans ce Dossier

"Nombre de classeurs en mémoire" : Tu as des classeurs ouverts ? Sinon tes classeurs sont sur le disque dur????

"nombre réel dans ce Dossier" : Où est-il ce nombre ? Comment tu le détermines?

Pour moi, ta question est incompréhensible!

Dans la procédure "Test", tu remplaces cette section :


With Range("A1").Resize(NbFichiers)
.Value = Application.Transpose(Arr)
.Sort [A1]
.EntireColumn.AutoFit
End With

Par

Msgbox Ubound(Arr)

Tu va avoir le nombre de tous les fichiers dans le répertoire et ses sous-répertoires

Si tu veux seulement les fichiers Excel, tu remplaces :
Const Masque = "*.*" 'à définir

Par
Const Masque = "*.xl*" 'à définir

 

[kjin]

Re : Plus rapide

Bonjour,
Je n'ai rien compris

Dim fso, rep, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set rep = fso.GetFolder(ThisWorkbook.Path & "\Fiche MP\")
Set f = rep.Files
MsgBox f.Count

A+
kjin

 

[WDAndCo]

Re : Plus rapide

Bonjour Le Forum

Merci MichD,
"Nombre de classeurs en mémoire" : Cells(1, 28).Value
Tu as des classeurs ouverts ? Non
Sinon tes classeurs sont sur le disque dur ? Sur un disque
"nombre réel de classeur dans ce Dossier" : Où est-il ce nombre ? Comment tu le détermines ? C'est le but de ma demarche

Merci Kjin, tres rapide mais 'Erreur d'executuion 450'

 

[MichD]

Re : Plus rapide

Exemple :

'-------------------------------
Sub Test()
ReDim Arr(1 To 1)
NbFichiers = 0
Recurse "c:\Users\Ton profil\Documents\"
MsgBox UBound(Arr)
End Sub
'-------------------------------

Ceci affiche le nombre de fichiers dans le répertoire et ses sous-répertoires

Je suppose que tu sais faire une comparaison avec le nombre de fichiers affichés dans une cellule.

C'était mon dernier message sur ce fil.

 

[WDAndCo]

Re : Plus rapide

Bonjour le Forum

Connaissez-vous un moyen plus rapide pour trouver le nombre de fichiers Excel dans un dossier que ce code ?

Option Explicit
Private Sub Workbook_Open()
Application.ScreenUpdating = 0
 
    Dim fCount As Long
    Dim sPath As String
    Dim Tmp As String
    Dim FolderFiles() As Variant
    
  sPath = ThisWorkbook.Path & "\Fiche MP\"
  fCount = 0
  Tmp = Dir(sPath & "*.*")
  While Tmp <> Empty
    fCount = fCount + 1
    ReDim Preserve FolderFiles(1 To fCount)
    FolderFiles(fCount) = Tmp
    Tmp = Dir
  Wend
  
  If Cells(1, 28).Value = fCount Then NonFiltre: Exit Sub
  
Call ListeTablo

End Sub

D’avance merci

 

[Efgé]

Re : Plus rapide

Bonjour WDAndCo, le fil
Au plus court (pour moi...)

Sub test()
Dim Dossier As Object
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path & "\Fiche MP\")
MsgBox Dossier.Files.Count
End Sub

Cordialement

 

[WDAndCo]

Re : Plus rapide

Bonjour le Forum
Merci Efgé, vraiment plus rapide, je peux ecrire cela ?

Option Explicit
Private Sub Workbook_Open()
Application.ScreenUpdating = 0
 
  Dim Dossier As Object
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path & "\Fiche MP\")

  If Cells(1, 28).Value = Dossier.Files.Count Then NonFiltre: Exit Sub
  
Call ListeTablo

End Sub

 

[job75]

Re : Plus rapide

Bonjour à tous,

Il y a des mystères...

La méthode utilisée par Efgé au post #9 est exactement celle de kjin au post #5 !!

Et d'après WDAndCo il y avait 'Erreur d'executuion 450' ...

A+

 

[Efgé]

Re : Plus rapide

Bonsoir à tous

Bonjour à tous,
Il y a des mystères...
La méthode utilisée par Efgé au post #9 est exactement celle de kjin au post #5 !!
Et d'après WDAndCo il y avait 'Erreur d'executuion 450' ...
A+

Je pense que le problèle venait de "Set f = rep.Files"

@ WDAndCo,
Tu peux utiliser ce code, mais...
Comme tu es dans une "Private Sub Workbook_Open()" Il faudrait, d'après moi, déclarer la feuille .....*
Cordialement

 

[WDAndCo]

Re : Plus rapide

Bonjour le Forum

Je confirme que le premier code renvoyé une erreur 450.

Déclaré la feuille, comment fait on cela ?
Juste pour info, car le code fonctionne.

 

[Efgé]

Re : Plus rapide

Bonjour WDAndCo, le fil,
Juste en la précisant:
If Sheets("Feuil1").Cells(1, 28).Value '...etc
Cordialement