Dùng VBA và Acrobat Pro để nhập các hạng mục chỉ định từ nhiều file PDF vào các ô Excel chỉ định

Doan Thang

Yêu THVBA
Việc nhập các thông số đo đạc từ nhiều bản PDF theo các Lot sản xuất khác nhau vaò Excel với số lượng nhiều sẽ tốn nhiều thời gian.
Hiện tôi đang dùng Adobe Acrobat DC phiên bản Pro. Qua tìm hiểu thì tôi tìm được link tham khảo nhưng bằng tiếng Nhật như bên dưới.
Do mới nhập môn nên tôi muốn nhờ các chuyên gia giúp tôi xây dựng code cho ví dụ như bên dưới. Tôi xin cám ơn.

------------------------------
1. Ví dụ Nội dung hiển thị của file PDF như dưới (Các hạng mục như Số Lot. ngày sản xuất, giá trị đo, đánh giá sẽ thay đổi theo từng Lot sản xuất)
Các file PDF sẽ được để trong cùng 1 thư mục[BẢNG KIỂM TRA] với tên file ví dụ Lot1.pdf, Lot2.pdf...Lot10.pdf (ở dưới tôi lấy ví dụ là Lot1)

BẢNG KIỂM TRA

TÊN SẢN PHẨM: Hộp giấy
SỐ LOT: 1
NGÀY SẢN XUẤT: 09/01/2020

HẠNG MỤC KIỂM TRA ĐƠN VỊ TIÊU CHUẨN GIÁ TRỊ ĐO ĐÁNH GIÁ
Chiều dài mm 100±1 100.1 OK
Chiều rộng mm 50±1 50.2 OK
Chiều cao mm 100±1 100.2 OK
Đường kính lỗ mm 15±1 15.1 OK

---------------------------
2. Ví dụ Nội dung sau khi nhập trên bảng Excel như bên dưới.

BẢNG KIỂM TRA

TÊN SẢN PHẨM: Hộp giấy

SỐ LOT NGÀY SẢN XUẤT Chiều dài Chiều rộng Chiều cao Đường kính lỗ Đánh giá
1 09/01/2020 100.1 50.2 100.2 15.1 ok
2 09/01/2020 100.2 50.2 100.2 15.2 ok
3 10/01/2020 100.4 50.2 100.3 15.2 ok
4 10/01/2020 100.2 50.1 100.3 15.2 ok
5 10/01/2020 100.6 50.1 100.3 15.4 ok
6 11/01/2020 100.1 50.5 100.3 15.4 ok
7 12/01/2020 100.1 50.5 100.3 15.4 ok
8 12/01/2020 100.1 50.1 100.3 15.6 ok
9 13/01/2020 100.4 50.4 100.4 15.6 ok
10 14/01/2020 100.3 50.3 100.4 15.3 ok









--------------------------
Link tham khảo tiếng Nhật


Code tham khảo:
'---コード1|フォルダ内のPDFファイルを1つずつ処理する
Option Explicit
Sub filecheck()
Dim s1, s2, s3, filename, path, xmlpath As String
Dim i, cmax As Long
Dim t1, t2 As Date
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets(データ一覧)
Dim fs As FileSystemObject
Dim basefolder As Scripting.Folder
Dim destifolder, filepath As String
Dim mysubfiles As Scripting.Files
Dim mysubfile As Scripting.File
cmax = ws1.Range(A65536).End(xlUp).Row
Set fs = New Scripting.FileSystemObject
filepath = ThisWorkbook.path ; \Analysis
Set basefolder = fs.GetFolder(filepath)
Set mysubfiles = basefolder.Files
For Each mysubfile In mysubfiles
Debug.Print mysubfile.Name
Debug.Print fs.GetExtensionName(mysubfile)
Debug.Print fs.GetParentFolderName(mysubfile)
If fs.GetExtensionName(path:=mysubfile) = pdf Then
path = fs.GetParentFolderName(path:=mysubfile)
xmlpath = xmlurl(mysubfile.Name, path)
Call xml_parse(xmlpath)
End If
Next
End Sub

'---コード2|PDF毎にxml化する
Function xmlurl(filename, path)
Dim objAcroApp As New Acrobat.AcroApp
Dim objAcroAVDoc As New Acrobat.AcroAVDoc
Dim objAcroPDDoc As Acrobat.AcroPDDoc
Dim id As Long
Dim js As Object
Dim fullpath, savename As String
fullpath = path ; \ ; filename
Debug.Print fullpath
id = objAcroApp.Show 'Acrobatアプリケーションを起動する。
id = objAcroAVDoc.Open(fullpath, )
Set objAcroPDDoc = objAcroAVDoc.GetPDDoc()
'JavaScriptオブジェクトを作成する。
Set js = objAcroPDDoc.GetJSObject
savename = Replace(fullpath, .pdf, )
js.SaveAs savename ; .xml, com.adobe.acrobat.xml-1-00
'PDFファイルを変更無しで閉じます。
id = objAcroAVDoc.Close(1)
'Acrobatアプリケーションを終了する。
id = objAcroApp.Hide
id = objAcroApp.Exit
'OLEを行うとAcrobatが不安定になるので、
'一応オブジェクトを強制開放する。
Set js = Nothing
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
xmlurl = savename ; .xml
End Function

'---コード3|フォルダ内のPDFファイルだけを抽出
Sub xml_parse(ByVal xmlpath As String)
'Microsoft XML v6.0 を参照設定
Dim XMLDocument As MSXML2.DOMDocument60
Dim pElem As MSHTML.HTMLParaElement
'Dim Doc As New XMLDocument
Dim e As MSHTML.HTMLHtmlElement
Dim ws1 As Worksheet
Set ws1 = Worksheets(データ一覧)
'MSXMLオブジェクトを生成し、xmlファイルをロード
Set XMLDocument = New MSXML2.DOMDocument60
'async = False → 読み込み終了後、次の処理をします(同期処理)
'async = true →だと、読み込みが終わらなくても、次のステップへ(非同期処理)
'VBAは非同期処理に対応していないので、async = Falseとします
XMLDocument.async = False
Dim strMsg As String
Dim i, j, k, cmax, n As Long
i = 0
cmax = ws1.Range(A1048576).End(xlUp).Row
'Doc.Load (xmlpath)
XMLDocument.Load (xmlpath)
If (XMLDocument.parseError.ErrorCode <> 0) Then 'ロード失敗
strMsg = XMLDocument.parseError.reason 'エラー内容を出力
MsgBox ロードに失敗しました・・・ ; vbCrLf ; vbCrLf ; strMsg, vbCritical
Exit Sub
End If
ws1.Range(A ; cmax + 1).Value = cmax
Dim objxml As Object
Dim tmp As Variant
For Each objxml In XMLDocument.getElementsByTagName(P)
If InStr(objxml.XML, 請求番号) > 0 Then
tmp = Split(objxml.Text, :)
For k = 0 To UBound(tmp)
Debug.Print tmp(k)
If InStr(tmp(k), 請求日) > 0 And InStr(tmp(k), 請求日の) = 0 Then
ws1.Range(B ; cmax + 1).Value = Left(tmp(k), Len(tmp(k)) - 3)
ElseIf InStr(tmp(k), 支払期日) > 0 Then
ws1.Range(C ; cmax + 1).Value = Left(tmp(k), Len(tmp(k)) - 4)
ElseIf InStr(tmp(k), 貴社コード) > 0 Then
ws1.Range(D ; cmax + 1).Value = Mid(tmp(k), 2, Len(tmp(k)) - 6)
ElseIf InStr(tmp(k), 契約番号) > 0 Then
ws1.Range(E ; cmax + 1).Value = Mid(tmp(k), 2, Len(tmp(k)) - 5)
ElseIf InStr(tmp(k), 支払方法) > 0 Then
ws1.Range(F ; cmax + 1).Value = Left(tmp(k), Len(tmp(k)) - 4)
ElseIf k = UBound(tmp) Then
ws1.Range(G ; cmax + 1).Value = Mid(tmp(k), 2)
End If
Next
tmp = Null
End If
Next
j = 0
Dim cnode, dnode As IXMLDOMNode
Dim str() As Variant
Dim tdvar As Variant
Set cnode = XMLDocument.SelectSingleNode(//Table)
j = 0
For Each dnode In cnode.getElementsByTagName(TD)
ReDim Preserve str(j)
str(j) = dnode.Text
Debug.Print j, str(j)
j = j + 1
Next
Dim kingaku, zeigaku As Double
Dim tekiyou As String
kingaku = 0
zeigaku = 0
tekiyou =
For j = 0 To UBound(str)
k = 4 * j + 1
If InStr(str(k), ご請求) > 0 Then
ws1.Range(H ; cmax + 1).Value = kingaku
ws1.Range(I ; cmax + 1).Value = zeigaku
ws1.Range(J ; cmax + 1).Value = kingaku + zeigaku
ws1.Range(K ; cmax + 1).Value = tekiyou
Exit For
ElseIf InStr(str(k), 消費税) > 0 Then
zeigaku = zeigaku + str(k + 2)
ElseIf str(k) <> Then
kingaku = kingaku + str(k + 2)
If tekiyou = Then
tekiyou = str(k)
End If
End If
Next
End Sub
 

tuhocvba

Administrator
Thành viên BQT
Trình bày như thế này thì ko dc đâu. Tôi khônh muốn bạn post bài trong 1 tháng.
 
V

vothanhthu

Guest
@Doan Thang Thứ nghĩ bạn nên đọc trước khi đăng bài. Bạn đang tạo một chủ đề không ai hiểu bạn muốn gì?
 

Doan Thang

Yêu THVBA
Trình bày như thế này thì ko dc đâu. Tôi khônh muốn bạn post bài trong 1 tháng.
Xin lỗi admin có thể nói cho tôi biết phải trình bày như thế nào thì mới được không ạ. Admin của diễn đàn ai khách vừa đến nhà đã dọa đuổi vậy rồi?
 

tuhocvba

Administrator
Thành viên BQT
1. Bạn đọc topic này:

2. Code phải để trong thẻ CODE
3. Nói rõ input là gì, ouput muốn như thế nào.
4. File demo đâu, đưa lên.
5. Tôi bảo bạn không post bài, xem người khác post mà học hỏi. Không ai là chủ hay khách, cách viết của bạn làm mất thời giờ của người khác.
 
Top