Option Compare Database Function RunModelStructureAnalysis() DoCmd.SetWarnings False DoCmd.RunSQL "DELETE * FROM _Report_ModelStructureErrors" DoCmd.SetWarnings True ResetSummaryTable CheckRelationsVersion_ChildrenOfNetworks CheckRelationsVersion_ChildrenOfTable CheckRelationsVersion_ChildrenOfAxis CheckRelationsVersion_ChildrenOfMembers CheckRelationsVersion_ChildrenOfLineItems CheckRelationsVersion_ChildrenOfConcepts CheckRelationsVersion_ChildrenOfAbstracts Debug.Print "Done" End Function Function ResetSummaryTable() DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Network = 0" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET TTable = 0" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Axis = 0" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Member = 0" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET LineItems = 0" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Concept = 0" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Abstract = 0" DoCmd.SetWarnings True Debug.Print "Done!" End Function Function AddMessageToDatabaseTable(strParentObjectClass As String, strChildObjectClass As String, strAccessionNumber As String, strGenerator As String, strNetworkName As String, strNetworkLabel As String, strMessage As String) Dim rsADD As Recordset Set rsADD = CurrentDb().OpenRecordset("SELECT * FROM _Report_ModelStructureErrors") rsADD.AddNew rsADD!AccessionNumber = strAccessionNumber rsADD!Generator = strGenerator rsADD!NetworkName = strNetworkName rsADD!NetworkLabel = Mid(strNetworkLabel, 1, 250) rsADD!ParentObjectClass = strParentObjectClass rsADD!ChildObjectClass = strChildObjectClass rsADD!Message = strMessage rsADD.Update Set rsADD = Nothing End Function Function CheckRelationsVersion_ChildrenOfNetworks() 'On Error GoTo ErrorHandler Dim oModelStructure As MSXML2.DOMDocument60 Dim rs As Recordset Set rs = CurrentDb().OpenRecordset("SELECT * FROM Submissions WHERE Flag = True") Dim intParentSought As Long Dim intTable As Long Dim intAxis As Long Dim intMember As Long Dim intLineItems As Long Dim intConcept As Long Dim intAbstract As Long intParentSought = 0 intTable = 0 intAxis = 0 intAxis2 = 0 intMember = 0 intLineItems = 0 intConcept = 0 intAbstract = 0 rs.MoveLast rs.MoveFirst Debug.Print "Filing count: " & rs.RecordCount Do While Not rs.EOF DoEvents 'Debug.Print rs.AbsolutePosition & " of " & rs.RecordCount Dim strFilePath As String strFilePath = rs!LinkToModelStructure Set oModelStructure = New MSXML2.DOMDocument60 oModelStructure.async = False oModelStructure.validateOnParse = False oModelStructure.Load (strFilePath) If oModelStructure.parseError.ErrorCode <> 0 Then Debug.Print "Error loading file: " & vbCrLf & vbCrLf & _ "File URL: " & oModelStructure.parseError.url & vbCrLf & _ "Line: " & oModelStructure.parseError.Line & vbCrLf & _ "Character: " & oModelStructure.parseError.linepos & vbCrLf & _ "File position: " & oModelStructure.parseError.filepos & vbCrLf & _ "Source text: " & oModelStructure.parseError.srcText & vbCrLf & _ "Error Code: " & oModelStructure.parseError.ErrorCode & vbCrLf & _ "Error Description: " & oModelStructure.parseError.reason & vbCrLf _ , vbCritical 'Exit Function End If 'MsgBox oModelStructure.XML oModelStructure.SetProperty "SelectionNamespaces", "xmlns:xbrli='http://www.xbrl.org/2003/instance' xmlns='http://www.xbrl.org/2003/instance' xmlns:xbrldi='http://xbrl.org/2006/xbrldi' xmlns:us-gaap='http://fasb.org/us-gaap/2011-01-31' xmlns:dei='http://xbrl.sec.gov/dei/2011-01-31' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'" 'Figures out what type of entity it is Dim oNodeList As MSXML2.IXMLDOMNodeList Set oNodeList = oModelStructure.selectNodes("//Network[@identifier!='http://www.xbrl.org/2003/role/link']") 'Debug.Print "Nodes: " & oNodeList.length intParentSought = intParentSought + oNodeList.length Dim i As Long For i = 0 To oNodeList.length - 1 'Debug.Print oNodeList.Item(i).selectSingleNode("@name").Text Dim oChildren As MSXML2.IXMLDOMNodeList Set oChildren = oNodeList.Item(i).selectSingleNode(".").childNodes Dim j As Long For j = 0 To oChildren.length - 1 Select Case oChildren.Item(j).nodeName Case "Table" intTable = intTable + 1 Case "Axis" intAxis = intAxis + 1 'Debug.Print "Illegal Axis: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Network", "Axis", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Member" intMember = intMember + 1 'Debug.Print "Illegal Member: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Network", "Member", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "LineItems" intLineItems = intLineItems + 1 'Debug.Print "Illegal LineItems: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Network", "LineItems", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Concept" Select Case oChildren.Item(j).selectSingleNode("@abstract").Text Case "true" 'is Abstract intAbstract = intAbstract + 1 Case "false" 'Is Concept intConcept = intConcept + 1 'Debug.Print "Illegal Concept: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Network", "Concept", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text End Select Case Else End Select Next j Next i Set oNodeList = Nothing Set oModelStructure = Nothing rs.MoveNext Loop Debug.Print " " Debug.Print "Parents (Networks): " & intParentSought Debug.Print " " Debug.Print "Networks : " & "0" Debug.Print "Member : " & intTable Debug.Print "Axis : " & intAxis Debug.Print "Member : " & intMember Debug.Print "LineItems: " & intLineItems Debug.Print "Concept : " & intConcept Debug.Print "Abstract : " & intAbstract Debug.Print " " DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Network = 0 WHERE Child = 'Network'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Network = " & intTable & " WHERE Child = 'TTable'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Network = " & intAxis & " WHERE Child = 'Axis'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Network = " & intMember & " WHERE Child = 'Member'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Network = " & intLineItems & " WHERE Child = 'LineItems'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Network = " & intConcept & " WHERE Child = 'Concept'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Network = " & intAbstract & " WHERE Child = 'Abstract'" DoCmd.SetWarnings True Exit Function ErrorHandler: If Err.Number <> 91 Then Debug.Print "Error number " & Err.Number & ": " & Err.Description 'MsgBox "Error number " & Err.Number & ": " & Err.Description End If Resume Next End Function Function CheckRelationsVersion_ChildrenOfTable() 'On Error GoTo ErrorHandler Dim oModelStructure As MSXML2.DOMDocument60 Dim rs As Recordset Set rs = CurrentDb().OpenRecordset("SELECT * FROM Submissions WHERE Flag = True") Dim intParentSought As Long Dim intNetwork As Long Dim intTable As Long Dim intAxis As Long Dim intMember As Long Dim intLineItems As Long Dim intConcept As Long Dim intAbstract As Long intParentSought = 0 intNetwork = 0 intTable = 0 intAxis = 0 intAxis2 = 0 intMember = 0 intLineItems = 0 intConcept = 0 intAbstract = 0 rs.MoveLast rs.MoveFirst 'Debug.Print "Start:" Do While Not rs.EOF DoEvents 'Debug.Print rs.AbsolutePosition & " of " & rs.RecordCount Dim strFilePath As String strFilePath = rs!LinkToModelStructure Set oModelStructure = New MSXML2.DOMDocument60 oModelStructure.async = False oModelStructure.validateOnParse = False oModelStructure.Load (strFilePath) If oModelStructure.parseError.ErrorCode <> 0 Then Debug.Print "Error loading file: " & vbCrLf & vbCrLf & _ "File URL: " & oModelStructure.parseError.url & vbCrLf & _ "Line: " & oModelStructure.parseError.Line & vbCrLf & _ "Character: " & oModelStructure.parseError.linepos & vbCrLf & _ "File position: " & oModelStructure.parseError.filepos & vbCrLf & _ "Source text: " & oModelStructure.parseError.srcText & vbCrLf & _ "Error Code: " & oModelStructure.parseError.ErrorCode & vbCrLf & _ "Error Description: " & oModelStructure.parseError.reason & vbCrLf _ , vbCritical 'Exit Function End If 'MsgBox oModelStructure.XML oModelStructure.SetProperty "SelectionNamespaces", "xmlns:xbrli='http://www.xbrl.org/2003/instance' xmlns='http://www.xbrl.org/2003/instance' xmlns:xbrldi='http://xbrl.org/2006/xbrldi' xmlns:us-gaap='http://fasb.org/us-gaap/2011-01-31' xmlns:dei='http://xbrl.sec.gov/dei/2011-01-31' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'" 'Figures out what type of entity it is Dim oNodeList As MSXML2.IXMLDOMNodeList Set oNodeList = oModelStructure.selectNodes("//Table") 'Debug.Print "Nodes: " & oNodeList.length intParentSought = intParentSought + oNodeList.length Dim i As Long For i = 0 To oNodeList.length - 1 'Debug.Print oNodeList.Item(i).selectSingleNode("@name").Text Dim oChildren As MSXML2.IXMLDOMNodeList Set oChildren = oNodeList.Item(i).selectSingleNode(".").childNodes Dim j As Long For j = 0 To oChildren.length - 1 Select Case oChildren.Item(j).nodeName Case "Network" intNetwork = intNetwork + 1 'Debug.Print "Illegal Network: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Table", "Network", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Table" intTable = intTable + 1 'Debug.Print "Illegal Table: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Table", "Table", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Axis" intAxis = intAxis + 1 Case "Member" intMember = intMember + 1 'Debug.Print "Illegal Member: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Table", "Member", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "LineItems" intLineItems = intLineItems + 1 Case "Concept" Select Case oChildren.Item(j).selectSingleNode("@abstract").Text Case "true" 'is Abstract intAbstract = intAbstract + 1 'Debug.Print "Illegal Abstract: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Table", "Abstract", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "false" 'Is Concept intConcept = intConcept + 1 'Debug.Print "Illegal Concept: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Table", "Concept", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text End Select Case Else End Select Next j Next i Set oNodeList = Nothing Set oModelStructure = Nothing rs.MoveNext Loop Debug.Print " " Debug.Print "Parents (Table): " & intParentSought Debug.Print " " Debug.Print "Network : " & intNetwork Debug.Print "Tables : " & intTable Debug.Print "Axis : " & intAxis Debug.Print "Member : " & intMember Debug.Print "LineItems: " & intLineItems Debug.Print "Concept : " & intConcept Debug.Print "Abstract : " & intAbstract Debug.Print " " DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET TTable = " & intNetwork & " WHERE Child = 'Network'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET TTable = " & intTable & " WHERE Child = 'TTable'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET TTable = " & intAxis & " WHERE Child = 'Axis'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET TTable = " & intMember & " WHERE Child = 'Member'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET TTable = " & intLineItems & " WHERE Child = 'LineItems'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET TTable = " & intConcept & " WHERE Child = 'Concept'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET TTable = " & intAbstract & " WHERE Child = 'Abstract'" DoCmd.SetWarnings True Exit Function ErrorHandler: If Err.Number <> 91 Then Debug.Print "Error number " & Err.Number & ": " & Err.Description 'MsgBox "Error number " & Err.Number & ": " & Err.Description End If Resume Next End Function Function CheckRelationsVersion_ChildrenOfAxis() 'On Error GoTo ErrorHandler Dim oModelStructure As MSXML2.DOMDocument60 Dim rs As Recordset Set rs = CurrentDb().OpenRecordset("SELECT * FROM Submissions WHERE Flag = True") Dim intParentSought As Long Dim intNetwork As Long Dim intTable As Long Dim intAxis As Long Dim intMember As Long Dim intLineItems As Long Dim intConcept As Long Dim intAbstract As Long intParentSought = 0 intNetwork = 0 intTable = 0 intAxis = 0 intAxis2 = 0 intMember = 0 intLineItems = 0 intConcept = 0 intAbstract = 0 rs.MoveLast rs.MoveFirst 'Debug.Print "Start:" Do While Not rs.EOF DoEvents 'Debug.Print rs.AbsolutePosition & " of " & rs.RecordCount Dim strFilePath As String strFilePath = rs!LinkToModelStructure Set oModelStructure = New MSXML2.DOMDocument60 oModelStructure.async = False oModelStructure.validateOnParse = False oModelStructure.Load (strFilePath) If oModelStructure.parseError.ErrorCode <> 0 Then Debug.Print "Error loading file: " & vbCrLf & vbCrLf & _ "File URL: " & oModelStructure.parseError.url & vbCrLf & _ "Line: " & oModelStructure.parseError.Line & vbCrLf & _ "Character: " & oModelStructure.parseError.linepos & vbCrLf & _ "File position: " & oModelStructure.parseError.filepos & vbCrLf & _ "Source text: " & oModelStructure.parseError.srcText & vbCrLf & _ "Error Code: " & oModelStructure.parseError.ErrorCode & vbCrLf & _ "Error Description: " & oModelStructure.parseError.reason & vbCrLf _ , vbCritical 'Exit Function End If 'MsgBox oModelStructure.XML oModelStructure.SetProperty "SelectionNamespaces", "xmlns:xbrli='http://www.xbrl.org/2003/instance' xmlns='http://www.xbrl.org/2003/instance' xmlns:xbrldi='http://xbrl.org/2006/xbrldi' xmlns:us-gaap='http://fasb.org/us-gaap/2011-01-31' xmlns:dei='http://xbrl.sec.gov/dei/2011-01-31' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'" 'Figures out what type of entity it is Dim oNodeList As MSXML2.IXMLDOMNodeList 'Set oNodeList = oModelStructure.selectNodes("//Concept[@name='" & rs_LookForConcepts!ConceptName & "']") Set oNodeList = oModelStructure.selectNodes("//Axis") 'Debug.Print "Nodes: " & oNodeList.length intParentSought = intParentSought + oNodeList.length Dim i As Long For i = 0 To oNodeList.length - 1 'Debug.Print oNodeList.Item(i).selectSingleNode("@name").Text Dim oChildren As MSXML2.IXMLDOMNodeList Set oChildren = oNodeList.Item(i).selectSingleNode(".").childNodes Dim j As Long For j = 0 To oChildren.length - 1 Select Case oChildren.Item(j).nodeName Case "Network" intNetwork = intNetwork + 1 'Debug.Print "Illegal Network: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Axis", "Network", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Table" intTable = intTable + 1 'Debug.Print "Illegal Table: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Axis", "Table", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Axis" intAxis = intAxis + 1 'Debug.Print "Illegal Axis: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Axis", "Axis", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Member" intMember = intMember + 1 Case "LineItems" intLineItems = intLineItems + 1 'Debug.Print "Illegal Axis: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Axis", "LineItems", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Concept" Select Case oChildren.Item(j).selectSingleNode("@abstract").Text Case "true" 'is Abstract intAbstract = intAbstract + 1 'Debug.Print "Illegal Abstract: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Axis", "Abstract", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "false" 'Is Concept intConcept = intConcept + 1 'Debug.Print "Illegal Concept: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Axis", "Concept", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text End Select Case Else End Select Next j Next i Set oNodeList = Nothing Set oModelStructure = Nothing rs.MoveNext Loop Debug.Print " " Debug.Print "Parents (Axis): " & intParentSought Debug.Print " " Debug.Print "Network : " & intNetwork Debug.Print "Tables : " & intTable Debug.Print "Axis : " & intAxis Debug.Print "Member : " & intMember Debug.Print "LineItems: " & intLineItems Debug.Print "Concept : " & intConcept Debug.Print "Abstract : " & intAbstract Debug.Print " " DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Axis = " & intNetwork & " WHERE Child = 'Network'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Axis = " & intTable & " WHERE Child = 'TTable'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Axis = " & intAxis & " WHERE Child = 'Axis'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Axis = " & intMember & " WHERE Child = 'Member'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Axis = " & intLineItems & " WHERE Child = 'LineItems'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Axis = " & intConcept & " WHERE Child = 'Concept'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Axis = " & intAbstract & " WHERE Child = 'Abstract'" DoCmd.SetWarnings True Exit Function ErrorHandler: If Err.Number <> 91 Then Debug.Print "Error number " & Err.Number & ": " & Err.Description 'MsgBox "Error number " & Err.Number & ": " & Err.Description End If Resume Next End Function Function CheckRelationsVersion_ChildrenOfMembers() 'On Error GoTo ErrorHandler Dim oModelStructure As MSXML2.DOMDocument60 Dim rs As Recordset Set rs = CurrentDb().OpenRecordset("SELECT * FROM Submissions WHERE Flag = True") Dim intParentSought As Long Dim intNetwork As Long Dim intTable As Long Dim intAxis As Long Dim intMember As Long Dim intLineItems As Long Dim intConcept As Long Dim intAbstract As Long intParentSought = 0 intNetwork = 0 intTable = 0 intAxis = 0 intAxis2 = 0 intMember = 0 intLineItems = 0 intConcept = 0 intAbstract = 0 rs.MoveLast rs.MoveFirst 'Debug.Print "Start:" Do While Not rs.EOF DoEvents 'Debug.Print rs.AbsolutePosition & " of " & rs.RecordCount Dim strFilePath As String strFilePath = rs!LinkToModelStructure Set oModelStructure = New MSXML2.DOMDocument60 oModelStructure.async = False oModelStructure.validateOnParse = False oModelStructure.Load (strFilePath) If oModelStructure.parseError.ErrorCode <> 0 Then Debug.Print "Error loading file: " & vbCrLf & vbCrLf & _ "File URL: " & oModelStructure.parseError.url & vbCrLf & _ "Line: " & oModelStructure.parseError.Line & vbCrLf & _ "Character: " & oModelStructure.parseError.linepos & vbCrLf & _ "File position: " & oModelStructure.parseError.filepos & vbCrLf & _ "Source text: " & oModelStructure.parseError.srcText & vbCrLf & _ "Error Code: " & oModelStructure.parseError.ErrorCode & vbCrLf & _ "Error Description: " & oModelStructure.parseError.reason & vbCrLf _ , vbCritical 'Exit Function End If 'MsgBox oModelStructure.XML oModelStructure.SetProperty "SelectionNamespaces", "xmlns:xbrli='http://www.xbrl.org/2003/instance' xmlns='http://www.xbrl.org/2003/instance' xmlns:xbrldi='http://xbrl.org/2006/xbrldi' xmlns:us-gaap='http://fasb.org/us-gaap/2011-01-31' xmlns:dei='http://xbrl.sec.gov/dei/2011-01-31' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'" 'Figures out what type of entity it is Dim oNodeList As MSXML2.IXMLDOMNodeList Set oNodeList = oModelStructure.selectNodes("//Member") 'Debug.Print "Nodes: " & oNodeList.length intParentSought = intParentSought + oNodeList.length Dim i As Long For i = 0 To oNodeList.length - 1 'Debug.Print oNodeList.Item(i).selectSingleNode("@name").Text Dim oChildren As MSXML2.IXMLDOMNodeList Set oChildren = oNodeList.Item(i).selectSingleNode(".").childNodes Dim j As Long For j = 0 To oChildren.length - 1 Select Case oChildren.Item(j).nodeName Case "Table" intTable = intTable + 1 'Debug.Print "Illegal Table: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Member", "Table", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Axis" intAxis = intAxis + 1 'Debug.Print "Illegal Axis: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Member", "Axis", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Member" intMember = intMember + 1 Case "LineItems" intLineItems = intLineItems + 1 'Debug.Print "Illegal LineItems: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Member", "LineItems", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Concept" Select Case oChildren.Item(j).selectSingleNode("@abstract").Text Case "true" 'is Abstract intAbstract = intAbstract + 1 'Debug.Print "Illegal Abstract: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Member", "Abstract", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "false" 'Is Concept intConcept = intConcept + 1 'Debug.Print "Illegal Concept: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Member", "Concept", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text End Select Case Else End Select Next j Next i Set oNodeList = Nothing Set oModelStructure = Nothing rs.MoveNext Loop Debug.Print " " Debug.Print "Parents (Member): " & intParentSought Debug.Print " " Debug.Print "Network : " & intNetwork Debug.Print "Tables : " & intTable Debug.Print "Axis : " & intAxis Debug.Print "Member : " & intMember Debug.Print "LineItems: " & intLineItems Debug.Print "Concept : " & intConcept Debug.Print "Abstract : " & intAbstract Debug.Print " " DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Member = " & intNetwork & " WHERE Child = 'Network'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Member = " & intTable & " WHERE Child = 'TTable'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Member = " & intAxis & " WHERE Child = 'Axis'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Member = " & intMember & " WHERE Child = 'Member'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Member = " & intLineItems & " WHERE Child = 'LineItems'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Member = " & intConcept & " WHERE Child = 'Concept'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Member = " & intAbstract & " WHERE Child = 'Abstract'" DoCmd.SetWarnings True Exit Function ErrorHandler: If Err.Number <> 91 Then Debug.Print "Error number " & Err.Number & ": " & Err.Description 'MsgBox "Error number " & Err.Number & ": " & Err.Description End If Resume Next End Function Function CheckRelationsVersion_ChildrenOfLineItems() 'On Error GoTo ErrorHandler Dim oModelStructure As MSXML2.DOMDocument60 Dim rs As Recordset Set rs = CurrentDb().OpenRecordset("SELECT * FROM Submissions WHERE Flag = True") Dim intNetwork As Long Dim intTable As Long Dim intAxis As Long Dim intMember As Long Dim intLineItems As Long Dim intLineItems2 As Long Dim intConcept As Long Dim intAbstract As Long intNetwork = 0 intTable = 0 intAxis = 0 intMember = 0 intLineItems = 0 intLineItems2 = 0 intConcept = 0 intAbstract = 0 rs.MoveLast rs.MoveFirst 'Debug.Print "Start:" Do While Not rs.EOF DoEvents 'Debug.Print rs.AbsolutePosition & " of " & rs.RecordCount Dim strFilePath As String strFilePath = rs!LinkToModelStructure Set oModelStructure = New MSXML2.DOMDocument60 oModelStructure.async = False oModelStructure.validateOnParse = False oModelStructure.Load (strFilePath) If oModelStructure.parseError.ErrorCode <> 0 Then Debug.Print "Error loading file: " & vbCrLf & vbCrLf & _ "File URL: " & oModelStructure.parseError.url & vbCrLf & _ "Line: " & oModelStructure.parseError.Line & vbCrLf & _ "Character: " & oModelStructure.parseError.linepos & vbCrLf & _ "File position: " & oModelStructure.parseError.filepos & vbCrLf & _ "Source text: " & oModelStructure.parseError.srcText & vbCrLf & _ "Error Code: " & oModelStructure.parseError.ErrorCode & vbCrLf & _ "Error Description: " & oModelStructure.parseError.reason & vbCrLf _ , vbCritical 'Exit Function End If 'MsgBox oModelStructure.XML oModelStructure.SetProperty "SelectionNamespaces", "xmlns:xbrli='http://www.xbrl.org/2003/instance' xmlns='http://www.xbrl.org/2003/instance' xmlns:xbrldi='http://xbrl.org/2006/xbrldi' xmlns:us-gaap='http://fasb.org/us-gaap/2011-01-31' xmlns:dei='http://xbrl.sec.gov/dei/2011-01-31' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'" 'Figures out what type of entity it is Dim oNodeList As MSXML2.IXMLDOMNodeList Set oNodeList = oModelStructure.selectNodes("//LineItems") 'Debug.Print "Nodes: " & oNodeList.length intLineItems = intLineItems + oNodeList.length Dim i As Long For i = 0 To oNodeList.length - 1 'Debug.Print oNodeList.Item(i).selectSingleNode("@name").Text Dim oChildren As MSXML2.IXMLDOMNodeList Set oChildren = oNodeList.Item(i).selectSingleNode(".").childNodes Dim j As Long For j = 0 To oChildren.length - 1 Select Case oChildren.Item(j).nodeName Case "Table" intTable = intTable + 1 'Debug.Print "Illegal Table: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "LineItems", "Table", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Axis" intAxis = intAxis + 1 'Debug.Print "Illegal Axis: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "LineItems", "Axis", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Member" intMember = intMember + 1 'Debug.Print "Illegal Member: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "LineItems", "Member", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "LineItems" intLineItems2 = intLineItems2 + 1 Debug.Print "Illegal LineItems: Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text Case "Concept" Select Case oChildren.Item(j).selectSingleNode("@abstract").Text Case "true" intAbstract = intAbstract + 1 Case "false" intConcept = intConcept + 1 End Select Case Else End Select Next j Next i Set oNodeList = Nothing Set oModelStructure = Nothing rs.MoveNext Loop Debug.Print " " Debug.Print "Parent (LineItems): " & intLineItems Debug.Print " " Debug.Print "Network : " & intNetwork Debug.Print "Tables : " & intTable Debug.Print "Axis : " & intAxis Debug.Print "Member : " & intMember Debug.Print "LineItems: " & intLineItems2 Debug.Print "Concept : " & intConcept Debug.Print "Abstract : " & intAbstract Debug.Print " " DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET LineItems = " & intNetwork & " WHERE Child = 'Network'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET LineItems = " & intTable & " WHERE Child = 'TTable'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET LineItems = " & intAxis & " WHERE Child = 'Axis'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET LineItems = " & intMember & " WHERE Child = 'Member'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET LineItems = " & intLineItems2 & " WHERE Child = 'LineItems'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET LineItems = " & intConcept & " WHERE Child = 'Concept'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET LineItems = " & intAbstract & " WHERE Child = 'Abstract'" DoCmd.SetWarnings True Exit Function ErrorHandler: If Err.Number <> 91 Then Debug.Print "Error number " & Err.Number & ": " & Err.Description 'MsgBox "Error number " & Err.Number & ": " & Err.Description End If Resume Next End Function Function CheckRelationsVersion_ChildrenOfConcepts() 'On Error GoTo ErrorHandler Dim oModelStructure As MSXML2.DOMDocument60 Dim rs As Recordset Set rs = CurrentDb().OpenRecordset("SELECT * FROM Submissions WHERE Flag = True") Dim intParentSought As Long Dim intNetwork As Long Dim intTable As Long Dim intAxis As Long Dim intMember As Long Dim intLineItems As Long Dim intConcept As Long Dim intAbstract As Long intParentSought = 0 intNetwork = 0 intTable = 0 intAxis = 0 intAxis2 = 0 intMember = 0 intLineItems = 0 intConcept = 0 intAbstract = 0 rs.MoveLast rs.MoveFirst 'Debug.Print "Start:" Do While Not rs.EOF DoEvents 'Debug.Print rs.AbsolutePosition & " of " & rs.RecordCount Dim strFilePath As String strFilePath = rs!LinkToModelStructure Set oModelStructure = New MSXML2.DOMDocument60 oModelStructure.async = False oModelStructure.validateOnParse = False oModelStructure.Load (strFilePath) If oModelStructure.parseError.ErrorCode <> 0 Then Debug.Print "Error loading file: " & vbCrLf & vbCrLf & _ "File URL: " & oModelStructure.parseError.url & vbCrLf & _ "Line: " & oModelStructure.parseError.Line & vbCrLf & _ "Character: " & oModelStructure.parseError.linepos & vbCrLf & _ "File position: " & oModelStructure.parseError.filepos & vbCrLf & _ "Source text: " & oModelStructure.parseError.srcText & vbCrLf & _ "Error Code: " & oModelStructure.parseError.ErrorCode & vbCrLf & _ "Error Description: " & oModelStructure.parseError.reason & vbCrLf _ , vbCritical 'Exit Function End If 'MsgBox oModelStructure.XML oModelStructure.SetProperty "SelectionNamespaces", "xmlns:xbrli='http://www.xbrl.org/2003/instance' xmlns='http://www.xbrl.org/2003/instance' xmlns:xbrldi='http://xbrl.org/2006/xbrldi' xmlns:us-gaap='http://fasb.org/us-gaap/2011-01-31' xmlns:dei='http://xbrl.sec.gov/dei/2011-01-31' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'" 'Figures out what type of entity it is Dim oNodeList As MSXML2.IXMLDOMNodeList Set oNodeList = oModelStructure.selectNodes("//Concept[@abstract='false']") 'Debug.Print "Nodes: " & oNodeList.length intParentSought = intParentSought + oNodeList.length Dim i As Long For i = 0 To oNodeList.length - 1 'Debug.Print oNodeList.Item(i).selectSingleNode("@name").Text & " PARENT " & oNodeList.Item(i).parentNode.selectSingleNode("@name").Text & " IS PARENT ABSTRACT " & oNodeList.Item(i).parentNode.selectSingleNode("@abstract").Text Dim oChildren As MSXML2.IXMLDOMNodeList Set oChildren = oNodeList.Item(i).selectSingleNode(".").childNodes 'Debug.Print "Children: " & oChildren.length Dim j As Long For j = 0 To oChildren.length - 1 Select Case oChildren.Item(j).nodeName Case "Network" intNetwork = intNetwork + 1 'Debug.Print "Illegal Network: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Concept", "Network", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Table" intTable = intTable + 1 'Debug.Print "Illegal Table: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Concept", "Table", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Axis" intAxis = intAxis + 1 'Debug.Print "Illegal Axis: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Concept", "Axis", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Member" intMember = intMember + 1 'Debug.Print "Illegal Member: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Concept", "Member", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "LineItems" intLineItems = intLineItems + 1 'Debug.Print "Illegal LineItems: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Concept", "LineItems", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Concept" Select Case oChildren.Item(j).selectSingleNode("@abstract").Text Case "true" 'is Abstract intAbstract = intAbstract + 1 Case "false" 'Is Concept intConcept = intConcept + 1 End Select Case Else End Select Next j Next i Set oNodeList = Nothing Set oModelStructure = Nothing rs.MoveNext Loop Debug.Print " " Debug.Print "Parents (Concept): " & intParentSought Debug.Print " " Debug.Print "Network : " & intNetwork Debug.Print "Tables : " & intTable Debug.Print "Axis : " & intAxis Debug.Print "Member : " & intMember Debug.Print "LineItems: " & intLineItems Debug.Print "Concept : " & intConcept Debug.Print "Abstract : " & intAbstract Debug.Print " " DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Concept = " & intNetwork & " WHERE Child = 'Network'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Concept = " & intTable & " WHERE Child = 'TTable'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Concept = " & intAxis & " WHERE Child = 'Axis'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Concept = " & intMember & " WHERE Child = 'Member'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Concept = " & intLineItems & " WHERE Child = 'LineItems'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Concept = " & intConcept & " WHERE Child = 'Concept'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Concept = " & intAbstract & " WHERE Child = 'Abstract'" DoCmd.SetWarnings True Exit Function ErrorHandler: If Err.Number <> 91 Then Debug.Print "Error number " & Err.Number & ": " & Err.Description 'MsgBox "Error number " & Err.Number & ": " & Err.Description End If Resume Next End Function Function CheckRelationsVersion_ChildrenOfAbstracts() 'On Error GoTo ErrorHandler Dim oModelStructure As MSXML2.DOMDocument60 Dim rs As Recordset Set rs = CurrentDb().OpenRecordset("SELECT * FROM Submissions WHERE Flag = True") Dim intParentSought As Long Dim intNetwork As Long Dim intTable As Long Dim intAxis As Long Dim intMember As Long Dim intLineItems As Long Dim intConcept As Long Dim intAbstract As Long intParentSought = 0 intNetwork = 0 intTable = 0 intAxis = 0 intAxis2 = 0 intMember = 0 intLineItems = 0 intConcept = 0 intAbstract = 0 rs.MoveLast rs.MoveFirst ' Debug.Print "Start:" Do While Not rs.EOF DoEvents 'Debug.Print rs.AbsolutePosition & " of " & rs.RecordCount Dim strFilePath As String strFilePath = rs!LinkToModelStructure Set oModelStructure = New MSXML2.DOMDocument60 oModelStructure.async = False oModelStructure.validateOnParse = False oModelStructure.Load (strFilePath) If oModelStructure.parseError.ErrorCode <> 0 Then Debug.Print "Error loading file: " & vbCrLf & vbCrLf & _ "File URL: " & oModelStructure.parseError.url & vbCrLf & _ "Line: " & oModelStructure.parseError.Line & vbCrLf & _ "Character: " & oModelStructure.parseError.linepos & vbCrLf & _ "File position: " & oModelStructure.parseError.filepos & vbCrLf & _ "Source text: " & oModelStructure.parseError.srcText & vbCrLf & _ "Error Code: " & oModelStructure.parseError.ErrorCode & vbCrLf & _ "Error Description: " & oModelStructure.parseError.reason & vbCrLf _ , vbCritical 'Exit Function End If 'MsgBox oModelStructure.XML oModelStructure.SetProperty "SelectionNamespaces", "xmlns:xbrli='http://www.xbrl.org/2003/instance' xmlns='http://www.xbrl.org/2003/instance' xmlns:xbrldi='http://xbrl.org/2006/xbrldi' xmlns:us-gaap='http://fasb.org/us-gaap/2011-01-31' xmlns:dei='http://xbrl.sec.gov/dei/2011-01-31' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'" 'Figures out what type of entity it is Dim oNodeList As MSXML2.IXMLDOMNodeList Set oNodeList = oModelStructure.selectNodes("//Concept[@abstract='true']") 'Debug.Print "Nodes: " & oNodeList.length intParentSought = intParentSought + oNodeList.length Dim i As Long For i = 0 To oNodeList.length - 1 'Debug.Print oNodeList.Item(i).selectSingleNode("@name").Text Dim oChildren As MSXML2.IXMLDOMNodeList Set oChildren = oNodeList.Item(i).selectSingleNode(".").childNodes 'Debug.Print "Children: " & oChildren.length Dim j As Long For j = 0 To oChildren.length - 1 Select Case oChildren.Item(j).nodeName Case "Network" intNetwork = intNetwork + 1 'Debug.Print "Illegal Network: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Abstract", "Network", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Table" intTable = intTable + 1 Case "Axis" intAxis = intAxis + 1 'Debug.Print "Illegal Axis: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Abstract", "Axis", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Member" intMember = intMember + 1 'Debug.Print "Illegal Member: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Abstract", "Member", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "LineItems" intLineItems = intLineItems + 1 'Debug.Print "Illegal LineItems: Generator " & rs!Generator & " Accession: " & rs!AccessionNumber & " Network: " & oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text & " " & oChildren.Item(j).selectSingleNode("@name").Text AddMessageToDatabaseTable "Abstract", "LineItems", "TEMP", "TEMP", oChildren.Item(j).selectSingleNode("ancestor::Network/@identifier").Text, oChildren.Item(j).selectSingleNode("ancestor::Network/@label").Text, oChildren.Item(j).selectSingleNode("@name").Text Case "Concept" Select Case oChildren.Item(j).selectSingleNode("@abstract").Text Case "true" 'is Abstract intAbstract = intAbstract + 1 Case "false" 'Is Concept intConcept = intConcept + 1 End Select Case Else End Select Next j Next i Set oNodeList = Nothing Set oModelStructure = Nothing rs.MoveNext Loop Debug.Print " " Debug.Print "Parents (Abstract): " & intParentSought Debug.Print " " Debug.Print "Network : " & intNetwork Debug.Print "Tables : " & intTable Debug.Print "Axis : " & intAxis Debug.Print "Member : " & intMember Debug.Print "LineItems: " & intLineItems Debug.Print "Concept : " & intConcept Debug.Print "Abstract : " & intAbstract Debug.Print " " DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Abstract = " & intNetwork & " WHERE Child = 'Network'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Abstract = " & intTable & " WHERE Child = 'TTable'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Abstract = " & intAxis & " WHERE Child = 'Axis'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Abstract = " & intMember & " WHERE Child = 'Member'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Abstract = " & intLineItems & " WHERE Child = 'LineItems'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Abstract = " & intConcept & " WHERE Child = 'Concept'" DoCmd.RunSQL "UPDATE _Report_ModelStructure_Summary SET Abstract = " & intAbstract & " WHERE Child = 'Abstract'" DoCmd.SetWarnings True Exit Function ErrorHandler: If Err.Number <> 91 Then Debug.Print "Error number " & Err.Number & ": " & Err.Description 'MsgBox "Error number " & Err.Number & ": " & Err.Description End If Resume Next End Function