How to pass DOMDocument to Subroutine

Question

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).

Answer 1

After already several days of trial and error with this issue I now just found out by chance that I can pass the DOM ByRef to the sub-routine without any other changes in the existing code, if I declare Dim xmlDoc As Object just and instead of Set xmlDoc = New MSXML2.DomDocument60 use Set xmlDoc = CreateObject("MSXML.DOMDocument"). I don't even need a reference to "Microsoft XML" anymore. So the working code now looks like this:

Sub Read_XML_Data()

Dim xmlDoc As Object
Dim xmlNode As Object
Dim strFilePath As String
Dim strFolder As String
Dim strContent As String

    'other code, doing stuff and assigning values to strFilePath and strFolder
    [...]

    Set xmlDoc = CreateObject("MSXML.DOMDocument")
    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
       
            strContent = Left(xmlNode.Attributes(0).Text, 1)

            Select Case Left(xmlNode.Attributes(0).Text, 1)
                
                Case 1
                    Read_XJustiz_v1 xmlDoc
                    Exit For
                
                Case Else
                    MsgBox ("XJustiz Version: " & Left(xmlNode.Attributes(0).Text, 1))
                    Exit For
       
            End Select
       
        End If
    
    Next

End Sub


Sub Read_XJustiz_v1(ByRef xmlDoc As Object)
    
    'checking the entities legal form
    If xmlDoc.getElementsByTagName("Beteiligter").Item(0).ChildNodes(1).ChildNodes(2).Text = "Gesellschaft mit beschränkter Haftung" Then 'no more error!
    
    'do the rest of the code
    [...]

End Sub

Unfortunately I am not able to explain why exactly stuff works as it does, but it does work.

I hope this might be helpful in case anyone ever has a similar problem

Answer 2

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