Chẳng hiểu bạn muốn làm gì? Nhưng cũng góp ý cho bạn như sau:
Không biết phân biệt A3, A4 như thế nào, bạn chạy code này thử xem:
Sub countpagepdf()
Dim strpdf As String, i As Long, spath As String, arr, result
arr = Range("A2:b" & [A100000].End(xlUp).Row)
ReDim result(1 To UBound(arr), 1 To 1)
With CreateObject("VBscript.RegExp")
For i = 1 To UBound(arr)
.Pattern = "/Count (\d+).*/Kids\[[^\]]+\]"
Open arr(i, 1) & arr(i, 2) For Binary As #1
strpdf = Space(LOF(1)): Get #1, , strpdf: Close #1
If .test(strpdf) Then result(i, 1) = .Execute(strpdf)(0).submatches(0)
Next i
[d2].Resize(UBound(result), 1) = result
End With
End Sub
thấy có code này cũng dùng được:
Function PDFPages(ByVal PDF_File As String) As Long
Dim FileNum As Long
Dim strRetVal As String
With CreateObject("VBscript.RegExp")
.Global = True
.Pattern = "/Type\s*/Page[^s]"
FileNum = FreeFile
Open PDF_File For Binary As #FileNum
strRetVal = Space(LOF(FileNum))
Get #FileNum, , strRetVal
Close #FileNum
PDFPages = .Execute(strRetVal).Count
End With
End Function
Code hên xui bạn, sau khi gửi mới thấy, mấy file tiếng việt nhằm khi lấy cũng không được, chủ yếu là tìm trong chuỗi trả về không có thì chịu, hi vọng giúp được phần nào cho bạn chủ topic.
Xử lý đường dẫn là tiếng Việt có dấu thì có thể dùng FileSystemObject.
Tất cả các file nằm trong 1 folder duy nhất ạ. Xin cảm ơn pro
Code này không phân biệt được A3, A4 ạ. Vì tổng số trang = số trang A3x2 + số trang A4. Xin cảm ơn pro
Sub Test()
Dim MyPath As String, MyFile As String
Dim i As Long
MyPath = "C:\Users\acct.gaproject\Desktop\"
MyFile = Dir(MyPath & Application.PathSeparator & "*.pdf", vbDirectory)
Range("A:B").ClearContents
Range("A1") = "File Name": Range("B1") = "Pages"
Range("A1:B1").Font.Bold = True
i = 1
Do While MyFile <> ""
i = i + 1
Cells(i, 1) = MyFile
Cells(i, 2) = GetPageNum(MyPath & Application.PathSeparator & MyFile)
MyFile = Dir
Loop
Columns("A:B").AutoFit
MsgBox "Total of " & i - 1 & " PDF files have been found" & vbCrLf _
& " File names and corresponding count of pages have been written on " _
& ActiveSheet.Name, vbInformation, "Report..."
End Sub
'
Function GetPageNum(PDF_File As String)
'Haluk 19/10/2008
Dim FileNum As Long
Dim strRetVal As String
Dim RegExp
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
FileNum = FreeFile
Open PDF_File For Binary As #FileNum
strRetVal = Space(LOF(FileNum))
Get #FileNum, , strRetVal
Close #FileNum
GetPageNum = RegExp.Execute(strRetVal).Count
End FunctionCode này không phân biệt được A3, A4 ạ. Vĩ dụ như file dưới thì em tính là 6 trang. Xin cám ơn pro
Vâng. Xin cám ơn pro.
Xin cám ơn pro.
Xin cám ơn pro. Em là dân nghiệp dư, nên cũng chỉ viết đượng code để đếm số trang thôi chứ không đọc được từng trang một.
Option Explicit
Public PDFDoc As AcroPDDoc, PDFPage As Object, A3&, A4&
Sub Main()
Dim fso As FileSystemObject, fld As Folder, fil As File, s$, i&, Arr()
Set fso = New FileSystemObject
Set PDFDoc = New AcroPDDoc
Set fld = fso.GetFolder(ThisWorkbook.Path)
ReDim Arr(1 To 1000, 1 To 3)
For Each fil In fld.Files
s = fil.Name
If Right(s, 4) = ".pdf" Then
CountPagesPDF (ThisWorkbook.Path & "\" & s)
i = i + 1
Arr(i, 1) = s
Arr(i, 2) = A3
Arr(i, 3) = A4
End If
Next
Range("A2:C" & Cells.Rows.Count).Clear
Range("A2:C" & (i + 1)) = Arr
Set PDFPage = Nothing
Set PDFDoc = Nothing
Set fso = Nothing
End Sub
Sub CountPagesPDF(FullFileName$)
Dim i&, n&, x, y
A3 = 0
A4 = 0
PDFDoc.Open (FullFileName)
n = PDFDoc.GetNumPages
For i = 0 To n - 1
Set PDFPage = PDFDoc.AcquirePage(i)
x = PDFPage.GetSize().x
y = PDFPage.GetSize().y
If x + y > 1500 Then A3 = A3 + 1 Else A4 = A4 + 1
Next
PDFDoc.Close
End SubXin cám ơn pro. Em đã làm được. Chúc pro sức khỏe
