[![画像の説明をここに入力][1]][1]
この画像のXMLの<ImageData src="image">タグ <ImageData src="image">
タグの部分のみをExcelに抽出したいです。
Option Explicit
Sub ボタン4_Click()
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)
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)
'プログラム終了
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)
'プログラム終了
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
'プログラムD-5|プログラム終了
End Sub