Skip to main content
Communityユーザーがトップに表示した
Communityユーザーがトップに表示した
Communityユーザーがトップに表示した
本文に 12 文字追加
ソース リンク
sayuri
  • 4.3万
  • 2
  • 33
  • 94

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

[![画像の説明をここに入力][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]
この画像の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
ソース リンク

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