0

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

1 件の回答 1

1

手元の環境で類似のコードを作成し、実行するとIf objChildxml.SelectNodes = "ImageData" Thenの行で下記のエラー 450が発生しました。

実行時エラー '450':
引数の数が一致していません。または不正なプロパティを指定しています。

このエラーがお困りの内容と想定して回答します。
SelectNodesは複数のノードを取得するメソッドなので、SelectNodes(引数)のように括弧と引数が必要です。
また、戻り値も引数に該当する複数のノードです。

下記のサンプルコードのように、objChildxml.nodeNameが"ImageData"かつobjChildxml.getAttribute("src")が"image"のノードかどうかを調べるロジックで今回の目的を達成できるでしょうか。

Sub ボタン1_Click()
    'シート設定
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet2")
    Call XmlParse(ws)
End Sub

Sub XmlParse(ws)
    Dim xmlString As String
    xmlString = "<Root>" & vbCrLf & _
                "  <TextData>hoge</TextData>" & vbCrLf & _
                "  <Images>" & vbCrLf & _
                "     <ImageData src=""image"">fuga</ImageData>" & vbCrLf & _
                "     <ImageData src=""image"">piyo</ImageData>" & vbCrLf & _
                "     <ImageData src=""href"">foo</ImageData>" & vbCrLf & _
                "  </Images>" & vbCrLf & _
                "</Root>" 

    'MSXMLオブジェクトを生成
    Dim XMLDocument As MSXML2.DOMDocument60
    Set XMLDocument = New MSXML2.DOMDocument60

    '非同期処理に対応しない
    XMLDocument.async = False

    'xmlファイルをロード
    XMLDocument.LoadXML (xmlString)

    'ロード失敗した場合、メッセージ表示してプログラム終了
    Dim strMsg As String
    If XMLDocument.parseError.ErrorCode <> 0 Then
        strMsg = XMLDocument.parseError.reason      'エラー内容を出力
        MsgBox "ロードに失敗しました・・・" & vbCrLf & vbCrLf & strMsg, vbCritical
        Exit Sub
    End If

    Call GetChildNodes(XMLDocument.ChildNodes, ws, 3)
End Sub

Sub GetChildNodes(objxml, ws, i)
    For Each objChildxml In objxml
        'objChildxmlのノード名がImageDataかつsrc="image"の場合、エクセルにテキストを書き出す
        If objChildxml.nodeName = "ImageData" Then
            If objChildxml.getAttribute("src") = "image" 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
          'objChildxmlに子要素があれば、再帰的に実行
        If objChildxml.HasChildNodes = True Then
            Call GetChildNodes(objChildxml.ChildNodes, ws, i)
        End If
    Next
End Sub

この回答がご質問の意図を汲み取れていない場合は、「正常終了するが○○の値が取れない」や「○○エラーが発生して動作しない」など、具体的に困っている箇所を質問文に明記していただくとより明確な回答が得られるかもしれません。

5
  • gyazo.com/1f6b5edc4f40e47ad3b8ba095b28ebd4 上記の画像の下の方にある <ImageData src="images/P0301H01MFU1000HM00200000_img_2.jpg"/> のタグを取り出したいのですが、教えていただいた方法でやると gyazo.com/fef6355f2ab7c2133c6ea59a98080f9a このようになってしまいます。 gyazo.com/e34e08dd2cab0fd319e04785ce03e965 このような場合どのようにしたら、よろしいでしょうか? Commented 2021年9月29日 6:36
  • ws.Range("B1").Offset(i, 0).Value = objChildxml.Text の部分が出力されないです。 補足、PDFをXMLファイルに変換してから、取ってこようとしています。 Commented 2021年9月29日 7:25
  • <ImageData src="images/P0301H01MFU1000HM00200000_img_2.jpg"/>の末尾が/>なので空要素タグです。そのため<開始タグ>Text</閉じタグ>のように中身のTextを取得することができません。このような場合nextSiblingを取得するのがよろしいかと存じます。
    – payaneco
    Commented 2021年9月29日 11:46
  • あまりこのようなことは申し上げたくないのですが、コメントいただいた画像の時点でご質問の表題のattributeと内容が異なります。具体的に困っている箇所を質問文に明記していただき、画像ではなく再現可能な短いサンプルコードを記述していただくとより明確な回答が得られるかもしれません。
    – payaneco
    Commented 2021年9月29日 11:49
  • 回答ありがとうございます。十分伝わりました。質問の仕方が悪く申し訳ありません。 Commented 2021年9月29日 15:43

この質問に回答するには、ログインする必要があります。

求めていた回答ではありませんか? のタグが付いた他の質問を参照する。