Skip to main content
2 / 2
本文に 12 文字追加
sayuri
  • 4.3万
  • 2
  • 33
  • 94

VBAを使って、XMLファイルの特定のタグ<ImageData src="image">のみをExcelに表示させたい

[![画像の説明をここに入力][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