Wrote two functions a to implement serialization/deseralization of PQ
Here goes... with a disclaimer, haven't looked for a while...
Function savePQ() As Boolean
Dim Q As WorkbookQuery
Dim Xml As Object
Dim Parent As Object, Node As Object
Dim Query As Object
'Dim Xml As New DOMDocument60
'Dim Parent As IXMLDOMElement, Node As IXMLDOMElement
'Dim Query As IXMLDOMCDATASection
'Dim Desc As IXMLDOMAttribute
Dim a&
Dim Path$
On Error GoTo savePQ
If Xml Is Nothing Then
Set Xml = CreateObject("Msxml2.DOMDocument")
End If
Set Parent = Xml.createElement("Queries")
For a = 1 To ActiveWorkbook.Queries.Count
Set Q = ActiveWorkbook.Queries(a)
Set Node = Xml.createElement("Query" + CStr(a))
Set Query = Xml.createCDATASection(Q.Formula)
Node.appendChild Query
Node.setAttribute "Description", Q.Description
Node.setAttribute "Name", Q.Name
Parent.appendChild Node
Next
Xml.appendChild Parent
Path = getOneDrivePath(ActiveWorkbook.Path) + "\PQ Queries.xml"
Xml.Save Path
Exit Function
savePQ:
MsgBox Error
End Function
Function loadPQ() As Boolean
Dim Q As WorkbookQuery
Dim Xml As Object
Dim Parent As Object, Node As Object
Dim Query As Object
Dim col As New Collection
Dim Desc As String
'Dim Xml As New DOMDocument60
'Dim Parent As IXMLDOMElement, Node As IXMLDOMElement
'Dim Query As IXMLDOMCDATASection
'Dim Desc As IXMLDOMAttribute
Dim a&
Dim Path$
If isPQQueriesLoaded Then
Exit Function
Else
isPQQueriesLoaded = True
End If
On Error GoTo loadPQ
If Xml Is Nothing Then
Set Xml = CreateObject("Msxml2.DOMDocument")
End If
Path = getOneDrivePath(ActiveWorkbook.Path) + "\PQ Queries.xml"
On Error Resume Next
Xml.Load Path
If Err <> 0 Then
Exit Function
End If
On Error GoTo loadPQ
If Xml.ChildNodes.Length Then
For Each Q In ActiveWorkbook.Queries
col.Add Q, Q.Name
Next
Set Parent = Xml.FirstChild
For a = 0 To Parent.ChildNodes.Length - 1
Set Node = Parent.ChildNodes(a)
Set Query = Node.FirstChild
Set Q = ActiveWorkbook.Queries(Node.getAttribute("Name"))
If Not Q Is Nothing Then
Desc = Node.getAttribute("Description")
If Q.Description <> Desc Then
Q.Description = Desc
End If
If Q.Formula <> Query.Text Then
Q.Formula = Query.Text
End If
col.Remove Q.Name
Else
Set Q = ActiveWorkbook.Queries.Add(Node.getAttribute("Name"), Query.Text, Node.getAttribute("Description"))
End If
Next
For Each Q In col
Q.Delete
Next
End If
Exit Function
loadPQ:
MsgBox Error
End Function
