[!][Enter a description of the image here][1][1]
I would like to extract only the <ImageData src="image"> tag part of the XML in this image into Excel.
The code is as follows.
Thank you for your cooperation.
Option Explicit
Sub Button 4_Click()
'Sheet Settings
Dimws As Worksheet
Settings = ThisWorkbook.Works("Sheet2")
Dim path As String
Dim fileName As String
fileName="\P0301H01MFU1000HM00200000.PDF"
path = ThisWorkbook.path&fileName
'Debug.Print path
US>'Run program B
Dim xmlpath As String
xmlpath=ConvertXml(path)
'Debug.Print xmlpath
US>'Run program C
Call XMLParse (xmlpath, ws)
US>'Configuring FileSystemObject
Dimfs As FileSystemObject
Settings = New Scripting.FileSystemObject
Delete 'xmlpath
'fs.DeleteFile(xmlpath)
End Sub
'--- xml for each code PDF
US>'Start Program
Function ConvertXml (path)
US>'Launch the Acrobat application
DimobjAcroApp As New Acrobat.AcroApp
objAcroApp.Show
US>'Open PDF in Acrobat
DimobjAcroAVDoc As New Acrobat.AcroAVDoc
SetobjAcroAVDoc=New Acrobat.AcroAVDoc
objAcroAVDoc.Open path, "
'Get PDF information
DimobjAcroPDoc As Acrobat.AcroPDoc
SetobjAcroPDoc=objAcroAVDoc.GetPDDoc()
'Create JavaScript object
Dimjs As Object
Sets = objAcroPDoc.GetJSObject
'Convert PDF to xml file
Dim savename As String
savename=Replace(path, "PDF", "xml")
js.SaveAsavename, "com.adobe.acrobat.xml-1-00"
'Close PDF file without modification
objAcroAVDoc.Close(1)
'Exit Acrobat Application
objAcroApp.Exit
'Object Release
Set js =
SetobjAcroPDoc=Nothing
SetobjAcroAVDoc=Nothing
SetobjAcroApp=Nothing
US>'Set the return value for the Function procedure
ConvertXml=savename
'End of program
End Function
US>'Start Program
US>'Read Xml file
SubXmlParse (xmlpath, ws)
US>'Generate MSXML object
Dim XMLDocument As MSXML2.DOMDocument60
Set XMLDocument=New MSXML2.DOMDocument60
'Not compatible with asynchronous processing
XMLDocument.async=False
Load 'xml file
XMLDocument.Load (xmlpath)
US>'If loading fails, display a message and exit the program
DimstrMsg As String
If XMLDocument.parseError.ErrorCode<>0 Then
strMsg = XMLDocument.parseError.reason' output error content
MsgBox "Load failed..." & vbCrLf & vbCrLf & strMsg, vbCritical
Exit Sub
End If
US>'Run Program D
Call GetChildNodes (XMLDocument.ChildNodes, ws, 3)
'End of program
End Sub
US>'Start Program
SubGetChildNodes(objxml, ws, i)
'Objxml elements are processed in order with For Each
DimobjChildxml As Object
For EachobjChildxml Inobjxml
US>'If program D-3|objChildxml has child elements, run program D recursively
IfobjChildxml.HasChildNodes=True Then
Call GetChildNodes (objChildxml.ChildNodes, ws, i)
Export text to Excel if 'objChildxml has no child elements
Else
IfobjChildxml.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
'Program D-5 | End of Program
End Sub
When I created and executed similar code in my environment, I encountered Error 450 on the IfobjChildxml.SelectNodes="ImageData" Then line below.
Runtime error '450':
The number of arguments does not match.Alternatively, you have specified.
Assume that this error is troubling you.
SelectNodes is a method for retrieving multiple nodes, so parentheses and arguments are required, such as SelectNodes.
The return value is also multiple nodes that correspond to the argument.
Can the logic to determine if objChildxml.nodeName is an "ImageData" and objChildxml.getAttribute("src") is an "image" node as shown in the sample code below?
Sub button 1_Click()
'Sheet Settings
Dimws As Worksheet
Settings = ThisWorkbook.Works("Sheet2")
Call XMLParse(ws)
End Sub
SubXmlParse(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>"
US>'Generate MSXML object
Dim XMLDocument As MSXML2.DOMDocument60
Set XMLDocument=New MSXML2.DOMDocument60
'Not compatible with asynchronous processing
XMLDocument.async=False
Load 'xml file
XMLDocument.LoadXML (xmlString)
US>'If loading fails, display a message and exit the program
DimstrMsg As String
If XMLDocument.parseError.ErrorCode<>0 Then
strMsg = XMLDocument.parseError.reason' output error content
MsgBox "Load failed..." & vbCrLf & vbCrLf & strMsg, vbCritical
Exit Sub
End If
Call GetChildNodes (XMLDocument.ChildNodes, ws, 3)
End Sub
SubGetChildNodes(objxml, ws, i)
For EachobjChildxml Inobjxml
Export text to Excel if objChildxml node name is ImageData and src="image"
IfobjChildxml.nodeName="ImageData" Then
IfobjChildxml.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 with child elements recursively
IfobjChildxml.HasChildNodes=True Then
Call GetChildNodes (objChildxml.ChildNodes, ws, i)
End If
Next
End Sub
If this answer does not understand your question's intentions, you may get a clearer answer by specifying specific difficulties in the questionnaire, such as "It ends normally, but I can't get a value for ○○" or "It doesn't work because of an error ○○."
© 2024 OneMinuteCode. All rights reserved.