Macro Pour Compter des fichiers PDF

Mister Binaire

XLDnaute Occasionnel
Bonjour le Forum,
J'aurais besoin d'une macro pour un compter un nombre de fichiers au format "pdf" localisé à un endroit précis d'un serveur ou d'un disque dur : Exemple : C:\Users\Jean-Philippe\Documents ou pour le serveur Z:\Portail Procédure.

Pour le serveur c'est pour compter le nombre de procédures localisé sur le portail (suite à un quiz que je voudrais lancer) il doit en avoir plusieurs centaines.

Cette macro devra être rattaché à un bouton et le résultat apparaître dans une fenêtre pour faire apparaître le résultat du quiz
devant le public ayant participé.

Merci de votre aide

Amicalement,
MB
 

gilbert_RGI

XLDnaute Barbatruc
Re : Macro Pour Compter des fichiers PDF

Bonjour

voilà un code pour trouver le nombre de pdf dans un dossier

a vous de changer le chemin

Sub Test()

'Compte tous les fichiers type .pdf
MsgBox NbFich(ThisWorkbook.Path, "PDF")
End Sub

Function NbFich(Chemin As String, ParamArray Termin() As Variant) As Long
'Auteur: Random
Dim Fichier As String
Dim Extension As Variant
Dim Compteur As Long

For Each Extension In Termin
Fichier = Dir(Chemin & "\*." & Extension)
Do Until Fichier = ""
Compteur = Compteur + 1
Fichier = Dir
Loop
Next Extension

NbFich = Compteur
End Function
 

camarchepas

XLDnaute Barbatruc
Re : Macro Pour Compter des fichiers PDF

Bonjour,


@ Hello Gilbert , pas vu poster presque en même temps

Une solution :

Code:
Sub test()
Dim FileSystemObject As Object, f As Object
Dim Compteur As Long
Dim Chemin As String

Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
Chemin = "C:\Appli_Excel"

For Each f In FileSystemObject.GetFolder(Chemin).Files
    If InStr(1, f.Name, ".pdf") > 0 Then Compteur = Compteur + 1
Next f
MsgBox "Nombre total de fichiers : " & Compteur
End Sub
 
Dernière édition:

david84

XLDnaute Barbatruc
Re : Macro Pour Compter des fichiers PDF

Bonjour,
If InStr(1, f.Name, ".pdf") > 0 Then Compteur = Compteur + 1
Je n'ai pas testé mais il me semble que "Recap_fichiers_pdf.xls" serait pris en compte alors que ce n'est pas une extension .pdf.
Peut-être que l'utilisation de like ferait l'affaire, du type
Code:
if f.Name like "*.pdf" then
mais non testé.
A+
 

kiki29

XLDnaute Barbatruc
Re : Macro Pour Compter des fichiers PDF

Salut, et un de plus, récursif ou non ( via les APIs ), à adapter.
 

Pièces jointes

  • Liste Fichiers.zip
    25.3 KB · Affichages: 46
  • Liste Fichiers.zip
    25.3 KB · Affichages: 53
  • Liste Fichiers.zip
    25.3 KB · Affichages: 78
Dernière édition:

Mister Binaire

XLDnaute Occasionnel
Re : Macro Pour Compter des fichiers PDF

Merci à vous tous de votre aide.
Vos macro marche très bien, cependant j'ai oublié de vous préciser quelques choses :
Les fichiers PDF sont localisés dans plusieurs sous répertoires . (+ de 100)
Voila qui va compliquer les choses .

Merci par avance à toutes celles et tout ceux qui pourront m'aider !!!

Amicalement,
MB
 

Mister Binaire

XLDnaute Occasionnel
Re : Macro Pour Compter des fichiers PDF

Merci Kiki 29 ton fichier est le top du top !!

Je peux même rechercher d'autres formats que le pdf !!!!!!!

Merci également à tout ceux qui m'ont aidés dans la recherche de cet outil !!

Amicalement,
MB
 
Dernière édition:

camarchepas

XLDnaute Barbatruc
Re : Macro Pour Compter des fichiers PDF

Re ,

bonjour za tous et toutes

la première version modifiée pour le fun

Pour autre que fichier pdf modifies extension
et pour adapter au bon répertoire modifies chemin

Code:
Sub test()
Dim FileSystemObject As Object, SsRep As Object, F As Object
Dim Compteur As Long
Dim Chemin As String, Extension as string

Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
Chemin = "\\FREEBOX\Disque dur\A_Moi" ' "C:\Appli_Excel"
Extension = ".pdf"
For Each SsRep In FileSystemObject.GetFolder(Chemin).SubFolders
    For Each F In SsRep.Files
     If InStr(1, F.Name, extension) > 0 Then Compteur = Compteur + 1
    Next F
Next SsRep
MsgBox "Nombre total de fichiers " & extension & " : " & Compteur
End Sub
 

david84

XLDnaute Barbatruc
Re : Macro Pour Compter des fichiers PDF

Bonjour,
quelques modifications dans la déclaration des API pour que le fichier de kiki29 puisse fonctionner avec une version 64 bits d'Excel (inclusion de PtrSafe + quelques arguments passés en LongPtr) :
Code:
#If Win64 Then
    Private Declare PtrSafe Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
    Private Declare PtrSafe Function FindFirstFile Lib "kernel32" _
            Alias "FindFirstFileA" _
            (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare PtrSafe Function FindNextFile Lib "kernel32" _
            Alias "FindNextFileA" _
            (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long
    Private Declare PtrSafe Function PathMatchSpec Lib "shlwapi" _
            Alias "PathMatchSpecW" _
            (ByVal pszFileParam As LongPtr, ByVal pszSpec As LongPtr) As LongPtr
#Else
    Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
    Private Declare Function FindFirstFile Lib "kernel32" _
            Alias "FindFirstFileA" _
            (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare Function FindNextFile Lib "kernel32" _
            Alias "FindNextFileA" _
            (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
    Private Declare Function PathMatchSpec Lib "shlwapi" _
            Alias "PathMatchSpecW" _
            (ByVal pszFileParam As Long, ByVal pszSpec As Long) As Long
#End If
A+
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 912
Membres
101 837
dernier inscrit
Ugo