[![画像の説明をここに入力][1]][1]
この画像のXMLの <ImageData src="image">
タグの部分のみをExcelに抽出したいです。
コードは、下記のようになっております。
よろしくお願いします。
Option Explicit
Sub ボタン4_Click()
'シート設定
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet2")
Dim path As String
Dim fileName As String
fileName = "\P0301H01MFU1000HM00200000.PDF"
path = ThisWorkbook.path & fileName
'Debug.Print path
'プログラムBを実行
Dim xmlpath As String
xmlpath = ConvertXml(path)
'Debug.Print xmlpath
'プログラムCを実行
Call XmlParse(xmlpath, ws)
'FileSystemObjectの設定
Dim fs As FileSystemObject
Set fs = New Scripting.FileSystemObject
'xmlpathを削除
'fs.DeleteFile (xmlpath)
End Sub
'---コードPDF毎にxml化する
'プログラム開始
Function ConvertXml(path)
'Acrobatアプリケーションを起動
Dim objAcroApp As New Acrobat.AcroApp
objAcroApp.Show
'AcrobatでPDFを開く
Dim objAcroAVDoc As New Acrobat.AcroAVDoc
Set objAcroAVDoc = New Acrobat.AcroAVDoc
objAcroAVDoc.Open path, ""
'PDFの情報を取得
Dim objAcroPDDoc As Acrobat.AcroPDDoc
Set objAcroPDDoc = objAcroAVDoc.GetPDDoc()
'JavaScriptオブジェクトを作成
Dim js As Object
Set js = objAcroPDDoc.GetJSObject
'PDFをxmlファイルに変換
Dim savename As String
savename = Replace(path, "PDF", "xml")
js.SaveAs savename, "com.adobe.acrobat.xml-1-00"
'PDFファイルを変更無しで閉じる
objAcroAVDoc.Close (1)
'Acrobatアプリケーションを終了
objAcroApp.Exit
'オブジェクト解放
Set js = Nothing
Set objAcroPDDoc = Nothing
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
'Funtionプロシージャの戻り値を設定
ConvertXml = savename
'プログラム終了
End Function
'プログラム開始
'Xmlファイルを読み込む
Sub XmlParse(xmlpath, ws)
'MSXMLオブジェクトを生成
Dim XMLDocument As MSXML2.DOMDocument60
Set XMLDocument = New MSXML2.DOMDocument60
'非同期処理に対応しない
XMLDocument.async = False
'xmlファイルをロード
XMLDocument.Load (xmlpath)
'ロード失敗した場合、メッセージ表示してプログラム終了
Dim strMsg As String
If XMLDocument.parseError.ErrorCode <> 0 Then
strMsg = XMLDocument.parseError.reason 'エラー内容を出力
MsgBox "ロードに失敗しました・・・" & vbCrLf & vbCrLf & strMsg, vbCritical
Exit Sub
End If
'プログラムDを実行
Call GetChildNodes(XMLDocument.ChildNodes, ws, 3)
'プログラム終了
End Sub
'プログラム開始
Sub GetChildNodes(objxml, ws, i)
'objxmlの要素をFor Eachで順番に処理
Dim objChildxml As Object
For Each objChildxml In objxml
'プログラムD-3|objChildxmlに子要素があれば、プログラムDを再帰的に実行
If objChildxml.HasChildNodes = True Then
Call GetChildNodes(objChildxml.ChildNodes, ws, i)
'objChildxmlに子要素がなければ、エクセルにテキストを書き出す
Else
If objChildxml.SelectNodes = "ImageData" Then
ws.Range("A1").Offset(i, 0).Value = i - 2
ws.Range("B1").Offset(i, 0).Value = objChildxml.Text
i = i + 1
End If
End If
Next
'プログラムD-5|プログラム終了
End Sub