xmlvbaparameter-passingpass-by-referencedomdocument

How to pass DOMDocument to Subroutine


I have a bunch of so called "structured data" from the German commercial register which comes in xml-files (one file always holds the data of one company). The data structure corresponds to the specifications of the German "XJustiz" xml-schema (a scheme specially developed to simplify electronic data exchange in the judicial sector). This xml-schema is updated on a regular basis and unfortunately it changes the structure or used ID's and tagnames from time to time. Also the data gathered from the commercial register does not correspond to a uniform XJustiz format, at the moment data is sometimes offered in the structure of XJustiz version 1 and sometimes in the structure of XJustiz version 3.

I already have working code for looping through all the downloaded xml-files in a desktop folder, reading the xml-structure and writing down the required information in a workbook for further processing an legal analysis for both, XJustiz versions 1 and 3, each in a separate file.

What I now want to achieve is to combine the two codes by applying a procedure first, that checks a certain node which holds information about the used XJustiz version and then calls a subroutine corresponding to this certain structure.

My current code as shown below loops through a specified directory, setting each xml-file as new DOMDocument60, reading the node containing the version information and then executing the sub-procedure, passing the reference to the xmlDoc - well, theoretically. This is where I ask for your help! In the subroutine, always the first line trying to deal with the DOM throws a Run-Time Error '91': Object Variable or With Block Variable Not Set.

Current code of the first routine:

Sub Read_XML_Data()

 [...]

'########## MAIN LOOP START ##########
Do While Len(strFilePath) > 0

   Set xmlDoc = New MSXML2.DOMDocument60
   xmlDoc.async = False
   xmlDoc.Load (strFolder & strFilePath)
        
   'Checking the XJustiz version
   For Each xmlNode In xmlDoc.getElementsByTagName("*")
            
      If StrComp(xmlNode.Attributes(0).Name, "xjustizversion", vbTextCompare) = 0 Then
           
         Select Case Left(xmlNode.Attributes(0).Text, 1)
            
            'Found version 1 and execute corresponding subroutine
            Case 1
               Read_XJustiz_v1 xmlDoc
               Exit For
                    
            Case Else
               MsgBox (strFilePath & " verwendet XJustiz Version " & Left(xmlNode.Attributes(0).Text, 1))
               Exit For
           
         End Select
           
      End If
        
   Next
        
strFilePath = Dir
    
Loop
'########## MAIN LOOP END ##########

End Sub

And the subroutine:

Sub Read_XJustiz_v1(ByRef xmlDoc As DOMDocument60)

Dim strContent As String

   strContent = xmlDoc.Text
    
   'This line raises the Error No. 91: Object Variable or With Block Variable Not Set.
   If xmlDoc.getElementsByTagName("Beteiligter").Item(0).ChildNodes(1).ChildNodes(2).Text = "Gesellschaft mit beschränkter Haftung" Then
   [...]
   End If

End Sub
  

So why can't I access the DOM from the subroutine and what to change for getting it to work?

I checked and the processed xml-file does contain the item xmlDoc.getElementsByTagName("Beteiligter").Item(0).ChildNodes(1).ChildNodes(2).Text so I assume that cannot be the problem here.

I already tried to avoid passing the DOM by passing the current strFolder and strFile ByVal instead, to re-set and re-load the DOM from inside the second subroutine. But doing so also leads to a raise of Run-Time Error '91' as soon as the DOM shall be accessed in the second subroutine.

Irritatingly in both cases the DOM, referred to as the xmlDoc, can be displayed by setting strContent = xmlDoc.text - so information is at hand somehow, but it seems the xml-structure with its tags and stuff is lost (anyhow it's not displayed in the string that I used to test if at least any data was passed). I really don't know what is going wrong.

I'd really like to avoid to put the (standalone) working codes for the two versions together in one module, since each one is quite long and the outcome wouldn't be maintainable anymore.

A workaround could be to put each working code with a separate for-each-loop at the beginning in separate modules and after the loop for one version is finished to trigger the next loop for another version (what leads to unnecessary looping, especially if there will be more different versions in the future).


Solution

  • Just to show that it can work just fine:

    Sub Read_XML_Data()
    
        Dim xmlDoc As MSXML2.DOMDocument60, vers, rootName As String, nd As Object
    
        Set xmlDoc = New MSXML2.DOMDocument60
        xmlDoc.async = False
        xmlDoc.SetProperty "SelectionLanguage", "XPath"  'to use XPath
        'document has a "default namespace", so add that with a dummy alias `xx`...
        xmlDoc.SetProperty "SelectionNamespaces", "xmlns:xx='http://www.xjustiz.de'"
        xmlDoc.Load "C:\Temp\xjustiz.xml"
        
        vers = xmlDoc.SelectSingleNode("//xx:nachrichtenkopf"). _
                      Attributes.getNamedItem("xjustizVersion").Text
        Debug.Print vers '3.2.1
        
        Select Case vers
            Case "3.2.1"
                Set nd = xmlDoc.SelectSingleNode("//xx:beteiligter")
                Debug.Print "Read_XML_Data:", nd.ChildNodes(0).Text '.ChildNodes(0).Text
                Read_XJustiz_v3_2_1 xmlDoc
            Case Else
                Debug.Print "Version:", vers
        End Select
    
    
    End Sub
    
    Sub Read_XJustiz_v3_2_1(xmlDoc As DOMDocument60)
        Dim nd As Object
        Set nd = xmlDoc.SelectSingleNode("//xx:beteiligter")
        Debug.Print "Read_XJustiz_v3_2_1:", nd.ChildNodes(0).Text '.ChildNodes(2).Text
    End Sub
    

    Output:

    Read_XML_Data               Muster und Kollegen 002
    Read_XJustiz_v3_2_1         Muster und Kollegen 002