مرحبا فواز
يعمل الرمز بشكل جيد في برنامج Excel الخاص بي ، ما هو إصدار Excel الذي تستخدمه؟
أو يمكنك إرسال مشكلتك التفصيلية أو ملفات pdf إلى بريدي الإلكتروني: skyyang @extendoffice. com.

مرحبًا ، Venkatesh G
يعمل الرمز بشكل جيد في برنامج Excel الخاص بي ، يرجى إرسال ملفات pdf إلى بريدي الإلكتروني: yy@addin99.com.
حتى نتمكن من التحقق من مكان المشكلة ، شكرًا لك!

مرحبا براشانت
للحصول على عدد جميع ملفات PDF من المجلد والمجلدات الفرعية ، يرجى تطبيق الكود أدناه:

الاختبار الفرعي ()
أنا خافت وطويلة
خافت xRg كمدى
خافت xStr كسلسلة
خافت xFd كملف الحوار
خافت xFdItem كمتغير
خافت xFileName كسلسلة
خافت xFileNum وطول
خافت RegExp ككائن
قم بتعيين xFd = Application.FileDialog (msoFileDialogFolderPicker)
إذا كان xFd.Show = -1 ثم
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
تعيين xRg = النطاق ("A1")
المدى ("أ: ب") محتويات واضحة
النطاق ("A1: B1"). Font.Bold = True
xRg = "اسم الملف"
xRg.Offset (0، 1) = "الصفحات"
أنا = 2
استدعاء SunTest (xFdItem، I)
إنهاء حالة
نهاية الفرعية

Sub SunTest (xFdItem كمتغير ، أنا طويل)
خافت xRg كمدى
خافت xStr كسلسلة
خافت xFd كملف الحوار
خافت xFileName كسلسلة
خافت xFileNum وطول
خافت RegExp ككائن
خافت xF ككائن
خافت xSF ككائن
خافت xFso ككائن
xFileName = Dir (xFdItem & "* .pdf" ، vbDirectory)
xStr = ""
القيام أثناء xFileName <> ""
الخلايا (I ، 1) = xFileName
تعيين RegExp = CreateObject ("VBscript.RegExp")
RegExp.Global = صحيح
RegExp.Pattern = "/ النوع \ s * / الصفحة [^ s]"
xFileNum = ملف مجاني
افتح (xFdItem & xFileName) للثنائي كـ #xFileNum
xStr = مسافة (LOF (xFileNum))
احصل على #xFileNum،، xStr
أغلق #xFileNum
الخلايا (I، 2) = RegExp.Execute (xStr)
أنا = أنا + 1
xFileName = دير
أنشوطة
الأعمدة ("أ: ب"). احتواء تلقائي
تعيين xFso = CreateObject ("Scripting.FileSystemObject")
تعيين xF = xFso.GetFolder (xFdItem)
لكل xSF في xF
استدعاء SunTest (xSF.Path & "\"، I)
التالى
نهاية الفرعية

من فضلك حاول ، آمل أن يساعدك!

هل يمكنك مساعدتي في الحصول على منشئ الملف وأبعاده؟

مرحبا،
على الرحب والسعة. سعيد لأنه يساعد. أي أسئلة، لا تتردد في الاتصال بنا. أتمنى لك يوماً عظيماً.
مع خالص الشكر والتقدير،
ماندي

شكرا جزيلا.
وبالمثل ، هل يمكنك حساب وتصنيف صفحات A3 و A4؟

هذا هو الكود الذي وجدته في مكان ما على الشبكة ، فهو ليس بالشكل الأمثل مثل طريقتك:
الخيار صريح
PDFDoc العام مثل AcroPDDoc ، صفحة PDF ككائن ، A3 & ، A4 &

الرئيسية من الباطن()
Dim fso كـ FileSystemObject ، fld كمجلد ، fil As File ، s $ ، i & ، Arr ()
تعيين fso = New FileSystemObject
تعيين PDFDoc = جديد AcroPDDoc
تعيين fld = fso.GetFolder (ThisWorkbook.Path)
ReDim Arr (1 To 1000، 1 To 3)
لكل فيل في الملفات
s = اسم الملف
If Right (s، 4) = ".pdf" ثم
CountPagesPDF (ThisWorkbook.Path & "\" & s)
أنا = أنا + 1
آر (أنا ، 1) = ث
آر (ط ، 2) = A3
آر (ط ، 3) = A4
إنهاء حالة
التالى
النطاق ("A2: C" & Cells.Rows.Count). مسح
المدى ("A2: C" & (i + 1)) = Arr
تعيين PDFPage = لا شيء
تعيين PDFDoc = لا شيء
تعيين fso = لا شيء
نهاية الفرعية

Sub CountPagesPDF (FullFileName $)
خافت i &، n &، x، y
A3 = 0
A4 = 0
PDFDoc.Open (FullFileName)
n = PDFDoc.GetNumPages
بالنسبة إلى i = 0 إلى n - 1
تعيين PDFPage = PDFDoc.AcquirePage (i)
x = PDFPage.GetSize (). x
y = PDFPage.GetSize (). ذ
إذا كانت x + y> 1500 ، فإن A3 = A3 + 1 عدا ذلك A4 = A4 + 1
التالى
وثيقة PDF
نهاية الفرعية

مرحبا دافني
لحل مشكلتك ، يرجى تطبيق الكود أدناه ، يرجى المحاولة ، آمل أن يساعدك!

الاختبار الفرعي ()
أنا خافت وطويلة
خافت xRg كمدى
خافت xStr كسلسلة
خافت xFd كملف الحوار
خافت xFdItem كمتغير
خافت xFileName كسلسلة
خافت xFileNum وطول
خافت RegExp ككائن
قم بتعيين xFd = Application.FileDialog (msoFileDialogFolderPicker)
إذا كان xFd.Show = -1 ثم
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
تعيين xRg = النطاق ("A1")
المدى ("أ: ب") محتويات واضحة
النطاق ("A1: B1"). Font.Bold = True
xRg = "اسم الملف"
xRg.Offset (0، 1) = "الصفحات"
xRg.Offset (0 ، 2) = "المسار"
xRg.Offset (0 ، 3) = "الحجم (ب)"
أنا = 2
استدعاء SunTest (xFdItem، I)
إنهاء حالة
نهاية الفرعية

Sub SunTest (xFdItem كمتغير ، أنا طويل)
خافت xRg كمدى
خافت xStr كسلسلة
خافت xFd كملف الحوار
خافت xFileName كسلسلة
خافت xFileNum وطول
خافت RegExp ككائن
خافت xF ككائن
خافت xSF ككائن
خافت xFso ككائن
xFileName = Dir (xFdItem & "* .pdf" ، vbDirectory)
xStr = ""
القيام أثناء xFileName <> ""
الخلايا (I ، 1) = xFileName
تعيين RegExp = CreateObject ("VBscript.RegExp")
RegExp.Global = صحيح
RegExp.Pattern = "/ النوع \ s * / الصفحة [^ s]"
xFileNum = ملف مجاني
افتح (xFdItem & xFileName) للثنائي كـ #xFileNum
xStr = مسافة (LOF (xFileNum))
احصل على #xFileNum،، xStr
أغلق #xFileNum
الخلايا (I، 2) = RegExp.Execute (xStr)
الخلايا (I ، 3) = xFdItem & xFileName
الخلايا (I ، 4) = FileLen (xFdItem & xFileName)
أنا = أنا + 1
xFileName = دير
أنشوطة
الأعمدة ("أ: ب"). احتواء تلقائي
تعيين xFso = CreateObject ("Scripting.FileSystemObject")
تعيين xF = xFso.GetFolder (xFdItem)
لكل xSF في xF
استدعاء SunTest (xSF.Path & "\"، I)
التالى
نهاية الفرعية

مرحبا سكاييانغ ،
آسف لصدم وظيفة قديمة.
شكرًا لك على الرمز أعلاه ، فهو يساعدني كثيرًا!
هل يمكنك ، حسب النوع الكافي ، مشاركة كيفية إضافة "تاريخ إنشاء الملف" أيضًا حيث يكون التنسيق هو التاريخ فقط ، دون تضمين الوقت ، DD / MMM / YYYY؟
بغض النظر عن المكان الذي أبحث فيه ، لا يمكنني تعديل التعليمات البرمجية الخاصة بك للقيام بذلك بشكل صحيح بنفسي ..

شكرا لكم مقدما!

شعاع

مرحبا فلافيو
للحصول على عدد جميع ملفات PDF من المجلد والمجلدات الفرعية ، يرجى تطبيق الكود أدناه:

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

من فضلك حاول ، آمل أن يساعدك!

مرحبا فلافيو
يمكنك تحميل ملف PDF الخاص بك هنا ، حتى نتمكن من التحقق من المشكلة.
شكرا!

مرحبًا يا SrdosPDF
قد يكون رمز VBA التالي مفيدًا لك ، يرجى تجربته:

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

نأمل أن يكون هذا يمكن أن تساعدك!

مرحبًا ، sroczeto ،
لحساب عدد الصفحات من .doc و. docx بالإضافة إلى ملفات PDF ، يرجى تطبيق الكود التالي:
الاختبار الفرعي ()
أنا خافت وطويلة
خافت xRg كمدى
خافت xStr كسلسلة
خافت xFd كملف الحوار
خافت xFdItem كمتغير
خافت xFileName كسلسلة
خافت xFileNum وطول
خافت RegExp ككائن
خافت xWdApp
خافت xWd
قم بتعيين xFd = Application.FileDialog (msoFileDialogFolderPicker)
إذا كان xFd.Show = -1 ثم
Application.ScreenUpdating = خطأ
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
xFileName = Dir (xFdItem & "* .pdf" ، vbDirectory)
تعيين xRg = النطاق ("A1")
المدى ("أ: ب") محتويات واضحة
النطاق ("A1: B1"). Font.Bold = True
xRg = "اسم الملف"
xRg.Offset (0، 1) = "الصفحات"
أنا = 2
xStr = ""
القيام أثناء xFileName <> ""
الخلايا (I ، 1) = xFileName
تعيين RegExp = CreateObject ("VBscript.RegExp")
RegExp.Global = صحيح
RegExp.Pattern = "/ النوع \ s * / الصفحة [^ s]"
xFileNum = ملف مجاني
افتح (xFdItem & xFileName) للثنائي كـ #xFileNum
xStr = مسافة (LOF (xFileNum))
احصل على #xFileNum،، xStr
أغلق #xFileNum
الخلايا (I، 2) = RegExp.Execute (xStr)
أنا = أنا + 1
xFileName = دير
أنشوطة
xFileName = Dir (xFdItem & "* .docx" ، vbDirectory)
تعيين xWdApp = CreateObject ("Word.Application")
القيام أثناء xFileName <> ""
الخلايا (I ، 1) = xFileName
xFileNum = ملف مجاني
تعيين xWd = GetObject (xFdItem & xFileName)
الخلايا (I، 2) = xWd.ActiveWindow.Panes (1) .Pages.Count
xWd إغلاق خطأ
أنا = أنا + 1
xFileName = دير
أنشوطة
الأعمدة ("أ: ب"). احتواء تلقائي
إنهاء حالة
Application.ScreenUpdating = ترو
نهاية الفرعية

بفضل الزميل! إنه يعمل على pdf و docx ، لكن ليس على ملفات doc. وسؤال واحد آخر ، هل يمكنك إضافة ذلك في المجلدات الفرعية أيضًا؟

مرحبًا جون ، لحساب صفحات doc و. docx بالإضافة إلى ملفات PDF ، يرجى تطبيق الكود التالي: إحصائيات فرعية صفحة ()
أنا خافت وطويلة
خافت xRg كمدى
خافت xStr كسلسلة
خافت xFd كملف الحوار
خافت xFdItem كمتغير
خافت xFileName كسلسلة
خافت xFileNum وطول
خافت RegExp ككائن
خافت xWdApp
خافت xWd
قم بتعيين xFd = Application.FileDialog (msoFileDialogFolderPicker)
إذا كان xFd.Show = -1 ثم
Application.ScreenUpdating = خطأ
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
xFileName = Dir (xFdItem & "* .pdf" ، vbDirectory)
تعيين xRg = النطاق ("A1")
المدى ("أ: ب") محتويات واضحة
النطاق ("A1: B1"). Font.Bold = True
xRg = "اسم الملف"
xRg.Offset (0، 1) = "الصفحات"
أنا = 2
xStr = ""
القيام أثناء xFileName <> ""
الخلايا (I ، 1) = xFileName
تعيين RegExp = CreateObject ("VBscript.RegExp")
RegExp.Global = صحيح
RegExp.Pattern = "/ النوع \ s * / الصفحة [^ s]"
xFileNum = ملف مجاني
افتح (xFdItem & xFileName) للثنائي كـ #xFileNum
xStr = مسافة (LOF (xFileNum))
احصل على #xFileNum،، xStr
أغلق #xFileNum
الخلايا (I، 2) = RegExp.Execute (xStr)
أنا = أنا + 1
xFileName = دير
أنشوطة
xFileName = Dir (xFdItem & "* .docx" ، vbDirectory)
تعيين xWdApp = CreateObject ("Word.Application")
القيام أثناء xFileName <> ""
الخلايا (I ، 1) = xFileName
xFileNum = ملف مجاني
تعيين xWd = GetObject (xFdItem & xFileName)
الخلايا (I، 2) = xWd.ActiveWindow.Panes (1) .Pages.Count
xWd إغلاق خطأ
أنا = أنا + 1
xFileName = دير
أنشوطة
xFileName = Dir (xFdItem & "* .doc" ، vbDirectory)
تعيين xWdApp = CreateObject ("Word.Application")
القيام أثناء xFileName <> ""
الخلايا (I ، 1) = xFileName
xFileNum = ملف مجاني
تعيين xWd = GetObject (xFdItem & xFileName)
الخلايا (I، 2) = xWd.ActiveWindow.Panes (1) .Pages.Count
xWd إغلاق خطأ
أنا = أنا + 1
xFileName = دير
أنشوطة
الأعمدة ("أ: ب"). احتواء تلقائي
إنهاء حالة
Application.ScreenUpdating = ترو
End Sub يرجى المحاولة ، آمل أن يساعدك!

مرحبًا ، لدي مجلد به عدة مجلدات فرعية. كيف يمكنني تحديد مسار المجلد الأصلي دون تحديده يدويًا. ثم أيضا إخراج اسم المجلد الفرعي. شكرا لك مقدما 

مرحبًا ، لقد قمت بتحرير الشفرة التي تمت إزالتها من XFD وقمت بتعيين مسار الملف كـ xfditem