XL 2016 Comptage fichiers dans un repertoire.

[christ77000]

Bonsoir à tous
j'ai une macro qui me compte le nombre de fichiers dans un répertoire donné. Ce que j'essaie de faire mais sans y arriver est de faire en sorte quelle me prenne en chemin la valeur de la cellule D1. L'utilisation de cette macro ce fait par l'appel de la fonction par "=GetFileList("L:\1. Sécurité & Environnement\Accidents & analyse 5 pourquoi et arbres des causes\2020\")" dans une cellule. J'ai essayer avec un Dim MonDossier As String et MonDossier = Range("D1").Value mais je ne sais pas comment et ou le placer. dans cette fonction. Et du a quoi serait égal le "GetFileList". Merci pour votre aide.

Function GetFileList(FileSpec As String) As Variant

Dim Filecount As Integer
Dim Filename As String

Application.Volatile
Filecount = 0
Filename = Dir(FileSpec)

If Filename = "" Then Exit Function

Do While Filename <> ""
    Filecount = Filecount + 1
    Filename = Dir()
Loop

GetFileList = Filecount

End Function

 

[Dranreb]

Bonsoir.
Quel est le problème exactement ?
La formule =GetFileList(D1) devrait donner le même résultat si D1 vaut "L:\1. Sécurité & Environnement\Accidents & analyse 5 pourquoi et arbres des causes\2020\"
Mais mettez plutôt Function GetFileList(ByVal FileSpec As String) As Variant, c'est plus correct et réduit le risque d'une erreur "Type d'argument ByRef incompatibilite", parce qu'il peut opérer une conversion de donnée au passage si nécessaire, ce qu'il ne peut pas toujours faire avec le ByRef appliqué par défaut.

 

[christ77000]

quand je mets getfilelist (d1) ça ne marche pas et en faite pourquoi prendre la valeur en D1. En C1 j'ai "L:\1. Sécurité & Environnement\Accidents & analyse 5 pourquoi et arbres des causes\2020\" et en D1 les utilisateurs peuvent rajouter leur repertoire donc D1 devient "L:\1. Sécurité & Environnement\Accidents & analyse 5 pourquoi et arbres des causes\2020\toto\"

 

[Dranreb]

Enlevez l'instruction If Filename = "" Then Exit Function Pour qu'il renvoie 0 s'il ne trouve aucun fichier correspondant au chemin. Vous parliez bien de l'appel de la fonction dans une formule de cellule au moins ?
Mettez un point d'arrêt au début de la fonction, mettez un espion sur FileSpec et déroulez en pas à pas.

 

[christ77000]

je viens de faire toutes les modifs a savoir Function GetFileList(ByVal FileSpec As String) As Variant
et enlevez l'instruction If Filename = "" Then Exit Function
j'ai mis dans une cellule =GetFileList(D1) le resultat est 0
je precise que D1 =CONCATENER(C1;F16).
C1="L:\1. Sécurité & Environnement\Accidents & analyse 5 pourquoi et arbres des causes\2020\" et F16=le nom du répertoire par équipe.

 

[Dranreb]

Et le '\' de fin ?
Moi je mettrais =GetFileList(C1&F16&"\*.*")

 

[TooFatBoy]

Bonjour,

Voici une approche un peu personnelle du sujet...

Pour la fonction, d'abord j'ajouterai un test pour ajouter un backslash à la fin du nom du dossier s'il n'y en a pas ; en suite j'essaierai de lui faire renvoyer -1 quand le dossier n'est pas trouvé, pour différencier d'un 0 (zéro) renvoyé quand le dossier est trouvé et qu'il est vide.

Function GetFileList(FileSpec As String) As Variant

Dim Filecount As Integer
Dim Filename As String

    Application.Volatile

    If Right(FileSpec, 1) <> "\" Then FileSpec = FileSpec & "\"

    Filename = Dir(FileSpec, vbDirectory)

    If Filename = "" Then

        Filecount = -1

    Else

        Filecount = -2
        Do While Filename <> ""
            Filecount = Filecount + 1
            Filename = Dir()
        Loop

    End If

    GetFileList = Filecount

End Function

Pour la formule, je mettrai :
=GetFileList(C1 & F16)
ou, si tu veux garder ton D1 :
=GetFileList(D1)

 

[christ77000]

Bonjour Marcel32, j'ais testé ton code fonctionne a merveille. Par contre ca fait quoi si je remplace -1 par 0.

 

[TooFatBoy]

Arf... dommage.

Chez moi ça fonctionne, donc difficile pour moi de voir d'où ça peut venir.
C'est peut-être à cause des "fichiers" . et .. ?
As-tu déroulé avec un point d'arrêt sur If Filename = "" Then pour voir la valeur de Filename ?

[edit]
Désolé, je n'avais pas vu que tu avais édité ton message.
Donc, content pour toi si ça fonctionne.
Si tu ne tiens pas compte du "-1", je n'ai au final rien fait de plus que reprendre le code que tu as donné et y intégrer ce que disait Dranreb (ajout d'un backslash pour signifier que c'est un dossier et non un fichier).

Tu peux remplacer le -1 par 0 sans problème. C'est juste que tu ne sauras pas si ce 0 veut dire que le dossier est vide ou que le dossier n'existe pas.
C'est juste un choix : c'est vous qui voyez...
[/edit]

 

[christ77000]

Non non ton code fonctionne c'est juste une question est ce grave de changer s'il ne trouve rien de mettre 0 au lieu de -1

 

[TooFatBoy]

Oui, j'ai vu. Donc j'ai édité moi aussi mon message.

 

[christ77000]

Merci a tous les deux pour votre aide si précieuse. Bonne journée

 

[TooFatBoy]

Si le "-1" ne t'intéresse pas, tu peux simplifier le code de la fonction et revenir quasiment à ce que tu avais au départ :

Function GetFileList(FileSpec As String) As Variant

Dim Filecount As Integer
Dim Filename As String

    Application.Volatile

    If Right(FileSpec, 1) <> "\" Then FileSpec = FileSpec & "\"
    Filename = Dir(FileSpec)

    Filecount = 0

    Do While Filename <> ""
        Filecount = Filecount + 1
        Filename = Dir()
    Loop

    GetFileList = Filecount

End Function

Bonne journée à toi également.

 

[Staple1600]

Bonjour le fil, tous

Confinement oblige, et pour varier les plaisirs
Un peu de pouvoir, un peu de coquille ...
PowerShell yo !

Sub Test_01()
'adapter le nom du dossier pour tester
pws_Compter_Fichiers "C:\Users\STAPLE\Documents\TESTS"
End Sub
Private Sub pws_Compter_Fichiers(Dossier As String, Optional Type_Fic As String = "*.*")
Dim Params$, tmpF$, NB_F&, pCmd As Variant
Params = Dossier & "\" & Type_Fic
tmpF = Environ("TEMP") & "\temp.txt"
pCmd = "PowerShell -Command " & ("Get-ChildItem -File '" & Params & "' -Recurse | Measure-Object | %{$_.Count} | Out-File -filePath '" & tmpF & "' -encoding ASCII")
CreateObject("WScript.Shell").Run pCmd, 0, True
NB_F = CreateObject("Scripting.FileSystemObject").OpenTextFile(tmpF).ReadAll: Kill tmpF
MsgBox NB_F 'pour test
Cells(1) = NB_F
End Sub