Bonjour Fawaz,
Le code fonctionne bien dans mon Excel, quelle version d'Excel utilisez-vous ?
Ou vous pouvez envoyer votre problème détaillé ou des fichiers pdf à mon e-mail : skyyang@extendoffice. Com.

Bonjour, Venkatesh G.
Le code fonctionne bien dans mon Excel, veuillez envoyer vos fichiers pdf à mon e-mail : yy@addin99.com.
Pour que nous puissions vérifier d'où vient le problème, merci !

Bonjour Prashant,
Pour obtenir le nombre de tous les fichiers PDF du dossier et des sous-dossiers, veuillez appliquer le code ci-dessous :

Sous-test ()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Dim xFileNum As Long
Dim RegExp comme objet
Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)
Si xFd.Show = -1 Alors
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Définir xRg = Plage("A1")
Range("A:B").ClearContents
Plage("A1:B1").Font.Bold = True
xRg = "Nom de fichier"
xRg.Offset(0, 1) = "Pages"
I = 2 XNUMX
Appeler SunTest(xFdItem, I)
Si fin
End Sub

Sub SunTest(xFdItem As Variant, I As Long)
Dim xRg As Range
Dim xStr As String
Boîte de dialogue Dim xFd en tant que fichier
Estomper xFileName en tant que chaîne
Dim xFileNum As Long
Dim RegExp comme objet
Dim xF comme objet
Dim xSF en tant qu'objet
Dim xFso en tant qu'objet
xNomFichier = Dir(xFdItem & "*.pdf", vbDirectory)
xStr = ""
Faire tant que xNomFichier <> ""
Cellules(I, 1) = xNomFichier
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = Vrai
RegExp.Pattern = "/Type\s*/Page[^s]"
xNumFichier = FichierLibre
Ouvrir (xFdItem & xFileName) pour le binaire en tant que #xFileNum
xStr = Espace(LOF(xFileNum))
Obtenir #xFileNum, , xStr
Fermer #xFileNum
Cellules(I, 2) = RegExp.Execute(xStr).Count
je = je + 1
xNomFichier = Répertoire
boucle
Colonnes("A:B").Ajustement automatique
Set xFso = CreateObject("Scripting.FileSystemObject")
Définir xF = xFso.GetFolder(xFdItem)
Pour chaque xSF dans xF.SubFolders
Appelez SunTest(xSF.Path & "\", I)
Suivant
End Sub

S'il vous plaît essayez, j'espère que cela peut vous aider!

Pouvez-vous m'aider à obtenir également le créateur et les dimensions du fichier ?

Bonjour,
Je vous en prie. Heureux que cela aide. Des questions, n'hesitez pas a nous contacter. Passe une bonne journée.
Sincèrement,
Mandy

Merci beaucoup.
De même, pouvez-vous compter et catégoriser les pages A3 et A4 ?

Voici le code que j'ai trouvé quelque part sur le net, il n'est pas aussi optimal que votre méthode :
Option explicite
PDFDoc public comme AcroPDDoc, PDFPage comme objet, A3&, A4&

Principal sous()
Dim fso As FileSystemObject, fld As Folder, fil As File, s$, i&, Arr()
Set fso = Nouveau FileSystemObject
Définir PDFDoc = Nouveau AcroPDDoc
Set fld = fso.GetFolder(ThisWorkbook.Path)
Redim Arr(1 à 1000, 1 à 3)
Pour chaque fichier dans fld.Files
s = fil.Nom
Si Droite(s, 4) = ".pdf" Alors
CountPagesPDF (ThisWorkbook.Path & "\" & s)
i = i + 1
Arr(i, 1) = s
Arr(i, 2) = A3
Arr(i, 3) = A4
Si fin
Suivant
Range("A2:C" & Cells.Rows.Count).Effacer
Plage("A2:C" & (i + 1)) = Arr
Définir PDFPage = Rien
Définir PDFDoc = Rien
Définir fso = Rien
End Sub

Sous-nombrePagesPDF(FullFileName$)
Dim i&, n&, x, y
A3 = 0
A4 = 0
PDFDoc.Ouvrir (NomFichierComplet)
n = PDFDoc.GetNumPages
Pour i = 0 À n - 1
Set PDFPage = PDFDoc.AcquirePage(i)
x = PDFPage.GetSize().x
y = PDFPage.GetSize().y
Si x + y > 1500 Alors A3 = A3 + 1 Sinon A4 = A4 + 1
Suivant
PDFDoc.Fermer
End Sub

Bonjour Daphné,
Pour résoudre votre problème, veuillez appliquer le code ci-dessous, veuillez essayer, j'espère qu'il pourra vous aider !

Sous-test ()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Dim xFileNum As Long
Dim RegExp comme objet
Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)
Si xFd.Show = -1 Alors
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Définir xRg = Plage("A1")
Range("A:B").ClearContents
Plage("A1:B1").Font.Bold = True
xRg = "Nom de fichier"
xRg.Offset(0, 1) = "Pages"
xRg.Offset(0, 2) = "Chemin"
xRg.Offset(0, 3) = "Taille(b)"
I = 2 XNUMX
Appeler SunTest(xFdItem, I)
Si fin
End Sub

Sub SunTest(xFdItem As Variant, I As Long)
Dim xRg As Range
Dim xStr As String
Boîte de dialogue Dim xFd en tant que fichier
Estomper xFileName en tant que chaîne
Dim xFileNum As Long
Dim RegExp comme objet
Dim xF comme objet
Dim xSF en tant qu'objet
Dim xFso en tant qu'objet
xNomFichier = Dir(xFdItem & "*.pdf", vbDirectory)
xStr = ""
Faire tant que xNomFichier <> ""
Cellules(I, 1) = xNomFichier
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = Vrai
RegExp.Pattern = "/Type\s*/Page[^s]"
xNumFichier = FichierLibre
Ouvrir (xFdItem & xFileName) pour le binaire en tant que #xFileNum
xStr = Espace(LOF(xFileNum))
Obtenir #xFileNum, , xStr
Fermer #xFileNum
Cellules(I, 2) = RegExp.Execute(xStr).Count
Cellules(I, 3) = xFdItem & xFileName
Cellules(I, 4) = FileLen(xFdItem & xFileName)
je = je + 1
xNomFichier = Répertoire
boucle
Colonnes("A:B").Ajustement automatique
Set xFso = CreateObject("Scripting.FileSystemObject")
Définir xF = xFso.GetFolder(xFdItem)
Pour chaque xSF dans xF.SubFolders
Appelez SunTest(xSF.Path & "\", I)
Suivant
End Sub

Salut skyyang,
Désolé de remonter un vieux post.
Merci pour le code ci-dessus, ça m'aide beaucoup!
Auriez-vous la gentillesse de partager comment ajouter la "date de création du fichier" également où le format est uniquement la date, pas d'heure incluse, JJ/MMM/AAAA ?
Peu importe où je cherche, je n'arrive pas à modifier votre code pour le faire correctement moi-même.

Je vous remercie à l'avance!

rayon

Bonjour Flavie,
Pour obtenir le nombre de tous les fichiers PDF du dossier et des sous-dossiers, veuillez appliquer le code ci-dessous :

Sub Test()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Set xRg = Range("A1")
Range("A:B").ClearContents
Range("A1:B1").Font.Bold = True
xRg = "File Name"
xRg.Offset(0, 1) = "Pages"
I = 2
Call SunTest(xFdItem, I)
End If
End Sub

Sub SunTest(xFdItem As Variant, I As Long)
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object
Dim xF As Object
Dim xSF As Object
Dim xFso As Object
xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
xStr = ""
Do While xFileName <> ""
Cells(I, 1) = xFileName
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
xFileNum = FreeFile
Open (xFdItem & xFileName) For Binary As #xFileNum
xStr = Space(LOF(xFileNum))
Get #xFileNum, , xStr
Close #xFileNum
Cells(I, 2) = RegExp.Execute(xStr).Count
I = I + 1
xFileName = Dir
Loop
Columns("A:B").AutoFit
Set xFso = CreateObject("Scripting.FileSystemObject")
Set xF = xFso.GetFolder(xFdItem)
For Each xSF In xF.SubFolders
Call SunTest(xSF.Path & "\", I)
Next
End Sub

S'il vous plaît essayez, j'espère que cela peut vous aider!

Bonjour Flavie,
Vous pouvez télécharger votre fichier PDF ici, afin que nous puissions vérifier le problème.
Merci !

Bonjour, SrdosPDF
Le code VBA suivant peut vous rendre service, veuillez l'essayer :

Sub Test()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
Set xRg = Range("A1")
Range("A:B").ClearContents
Range("A1:B1").Font.Bold = True
xRg = "File Name"
xRg.Offset(0, 1) = "Pages"
xRg.Offset(0, 2) = "Size(b)"
I = 2
Call SunTest(xFdItem, I)
End If
End Sub

Sub SunTest(xFdItem As Variant, I As Long)
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object
Dim xF As Object
Dim xSF As Object
Dim xFso As Object
xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
xStr = ""
Do While xFileName <> ""
Cells(I, 1) = xFileName
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
xFileNum = FreeFile
Open (xFdItem & xFileName) For Binary As #xFileNum
xStr = Space(LOF(xFileNum))
Get #xFileNum, , xStr
Close #xFileNum
Cells(I, 2) = RegExp.Execute(xStr).Count
Cells(I, 3) = FileLen(xFdItem & xFileName)
I = I + 1
xFileName = Dir
Loop
Columns("A:B").AutoFit
Set xFso = CreateObject("Scripting.FileSystemObject")
Set xF = xFso.GetFolder(xFdItem)
For Each xSF In xF.SubFolders
Call SunTest(xSF.Path & "\", I)
Next
End Sub

J'espère que cela pourra vous aider !

Salut, sroczeto,
Pour compter le nombre de pages des .doc et .docx ainsi que les fichiers PDF, veuillez appliquer le code suivant :
Sous-test ()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Dim xFileNum As Long
Dim RegExp comme objet
Dim xWdApp
Dim xWd
Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)
Si xFd.Show = -1 Alors
Application.ScreenUpdating = Faux
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xNomFichier = Dir(xFdItem & "*.pdf", vbDirectory)
Définir xRg = Plage("A1")
Range("A:B").ClearContents
Plage("A1:B1").Font.Bold = True
xRg = "Nom de fichier"
xRg.Offset(0, 1) = "Pages"
I = 2 XNUMX
xStr = ""
Faire tant que xNomFichier <> ""
Cellules(I, 1) = xNomFichier
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = Vrai
RegExp.Pattern = "/Type\s*/Page[^s]"
xNumFichier = FichierLibre
Ouvrir (xFdItem & xFileName) pour le binaire en tant que #xFileNum
xStr = Espace(LOF(xFileNum))
Obtenir #xFileNum, , xStr
Fermer #xFileNum
Cellules(I, 2) = RegExp.Execute(xStr).Count
je = je + 1
xNomFichier = Répertoire
boucle
xFileName = Dir(xFdItem & "*.docx", vbDirectory)
Set xWdApp = CreateObject("Word.Application")
Faire tant que xNomFichier <> ""
Cellules(I, 1) = xNomFichier
xNumFichier = FichierLibre
Définir xWd = GetObject(xFdItem & xFileName)
Cellules(I, 2) = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Fermer Faux
je = je + 1
xNomFichier = Répertoire
boucle
Colonnes("A:B").Ajustement automatique
Si fin
Application.ScreenUpdating = True
End Sub

Merci mon pote! Cela fonctionne sur pdf et docx, mais pas sur les fichiers doc. Et une question de plus, pouvez-vous ajouter que cela comptera également dans les sous-dossiers ?

Bonjour John, Pour compter les pages de .doc et .docx ainsi que les fichiers PDF, veuillez appliquer le code suivant : Sous PageStatistiques()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Boîte de dialogue Dim xFd en tant que fichier
Dim xFdItem comme variante
Estomper xFileName en tant que chaîne
Dim xFileNum As Long
Dim RegExp comme objet
Dim xWdApp
Dim xWd
Définir xFd = Application. FileDialog (msoFileDialogFolderPicker)
Si xFd.Show = -1 Alors
Application.ScreenUpdating = Faux
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xNomFichier = Dir(xFdItem & "*.pdf", vbDirectory)
Définir xRg = Plage("A1")
Range("A:B").ClearContents
Plage("A1:B1").Font.Bold = True
xRg = "Nom de fichier"
xRg.Offset(0, 1) = "Pages"
I = 2 XNUMX
xStr = ""
Faire tant que xNomFichier <> ""
Cellules(I, 1) = xNomFichier
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = Vrai
RegExp.Pattern = "/Type\s*/Page[^s]"
xNumFichier = FichierLibre
Ouvrir (xFdItem & xFileName) pour le binaire en tant que #xFileNum
xStr = Espace(LOF(xFileNum))
Obtenir #xFileNum, , xStr
Fermer #xFileNum
Cellules(I, 2) = RegExp.Execute(xStr).Count
je = je + 1
xNomFichier = Répertoire
boucle
xFileName = Dir(xFdItem & "*.docx", vbDirectory)
Set xWdApp = CreateObject("Word.Application")
Faire tant que xNomFichier <> ""
Cellules(I, 1) = xNomFichier
xNumFichier = FichierLibre
Définir xWd = GetObject(xFdItem & xFileName)
Cellules(I, 2) = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Fermer Faux
je = je + 1
xNomFichier = Répertoire
boucle
xNomFichier = Dir(xFdItem & "*.doc", vbDirectory)
Set xWdApp = CreateObject("Word.Application")
Faire tant que xNomFichier <> ""
Cellules(I, 1) = xNomFichier
xNumFichier = FichierLibre
Définir xWd = GetObject(xFdItem & xFileName)
Cellules(I, 2) = xWd.ActiveWindow.Panes(1).Pages.Count
xWd.Fermer Faux
je = je + 1
xNomFichier = Répertoire
boucle
Colonnes("A:B").Ajustement automatique
Si fin
Application.ScreenUpdating = True
End SubVeuillez essayer, j'espère que cela pourra vous aider !

Salut, j'ai un dossier avec plusieurs sous-dossiers Comment puis-je spécifier le chemin du dossier parent sans le sélectionner manuellement. Ensuite, la sortie indique également le nom du dossier enfant. Merci d'avance 

HI trié j'ai édité le code supprimé XFD et défini filpath comme xfditem