Created
September 4, 2018 17:14
-
-
Save JamesIgoe/3035fbf0048d1e40f561443fc37fdbd1 to your computer and use it in GitHub Desktop.
This code shows the basics of working with CustomXmlPart of the Office 2007 and greater environment. It is a way to store complex information within workbooks. In this example, I create a type, and the create XML to stores the type, and then either set, or retrieve the XML.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Option Explicit | |
Type Execution | |
SheetCodeName As String | |
StoredProcedure As String | |
Date As String | |
Portfolios As String | |
Fields As String | |
End Type | |
Public Sub SetCustomXmlPartToWorkbook(ByRef wkbCurrent As Workbook, ByRef typExecution As Execution) | |
Dim xmlString As String | |
Dim executionXMLPart As Office.CustomXMLPart | |
xmlString = ConvertExecutionToXml(typExecution) | |
Set executionXMLPart = GetCustomXmlPart(wkbCurrent, typExecution.SheetCodeName) | |
If Not IsNothing(executionXMLPart) Then | |
executionXMLPart.Delete | |
End If | |
Set executionXMLPart = wkbCurrent.CustomXMLParts.Add(xmlString) | |
End Sub | |
Public Function GetExistingTypeExecution(ByRef wkbCurrent As Workbook, ByRef strSheet As String) As Execution | |
Dim xmlString As String | |
Dim executionXMLPart As Office.CustomXMLPart | |
Dim typExecution As Execution | |
Set executionXMLPart = GetCustomXmlPart(wkbCurrent, strSheet) | |
xmlString = executionXMLPart.XML | |
GetExistingTypeExecution = GetTypeExecutionFromXml(xmlString) | |
End Function | |
Public Function GetNewTypeExecution(ByVal strSheet As String, _ | |
ByVal strStoredProcedure As String, _ | |
ByVal strDate As String, _ | |
ByVal strPortfolios As String, _ | |
ByVal strFields As String) As Execution | |
Dim typExecution As Execution | |
With typExecution | |
.SheetCodeName = strSheet | |
.StoredProcedure = strStoredProcedure | |
.Date = strDate | |
.Portfolios = strPortfolios | |
.Fields = strFields | |
End With | |
GetNewTypeExecution = typExecution | |
End Function | |
Private Function ConvertExecutionToXml(ByRef typExecution As Execution) As String | |
Dim xmlString As String | |
xmlString = "<?xml version=""1.0"" encoding=""utf-8"" ?>" & _ | |
"<executions xmlns=""http://schemas.microsoft.com/vsto/samples"">" & _ | |
"<execution>" & _ | |
"<sheetCodeName>" & typExecution.SheetCodeName & "</sheetCodeName>" & _ | |
"<storedProcedure>" & typExecution.StoredProcedure & "</storedProcedure>" & _ | |
"<date>" & typExecution.Date & "</date>" & _ | |
"<portfolios>" & typExecution.Portfolios & "</portfolios>" & _ | |
"<fields>" & typExecution.Fields & "</fields>" & _ | |
"</execution>" & _ | |
"</executions>" | |
ConvertExecutionToXml = xmlString | |
End Function | |
Private Function GetTypeExecutionFromXml(ByVal strXml) As Execution | |
Dim typExecution As Execution | |
Dim oDoc As MSXML2.DOMDocument | |
Dim oRS As ADODB.Recordset | |
Dim oNode As MSXML2.IXMLDOMNode | |
Dim oSubNodes As MSXML2.IXMLDOMSelection | |
Set oDoc = New MSXML2.DOMDocument | |
Call oDoc.LoadXML(strXml) | |
Set oNode = oDoc.ChildNodes(1).FirstChild | |
typExecution.SheetCodeName = oNode.ChildNodes(0).text | |
typExecution.StoredProcedure = oNode.ChildNodes(1).text | |
typExecution.Date = oNode.ChildNodes(2).text | |
typExecution.Portfolios = oNode.ChildNodes(3).text | |
typExecution.Fields = oNode.ChildNodes(4).text | |
GetTypeExecutionFromXml = typExecution | |
End Function | |
Private Function GetCustomXmlPart(ByRef wkbCurrent As Workbook, ByVal strSheet As String) As Office.CustomXMLPart | |
Dim xmlString As String | |
Dim executionXMLPart As Office.CustomXMLPart | |
Dim typExecution As Execution | |
''iterateitemsto find sheet | |
For Each executionXMLPart In wkbCurrent.CustomXMLParts | |
xmlString = executionXMLPart.XML | |
If InStr(UCase(xmlString), UCase("<sheetCodeName>" & strSheet & "</sheetCodeName>")) > 0 Then | |
Set GetCustomXmlPart = executionXMLPart | |
Exit For | |
End If | |
Next executionXMLPart | |
End Function | |
Private Sub DeleteCustomXmlPartToWorkbook(ByRef wkbCurrent As Workbook, ByRef typExecution As Execution) | |
Dim executionXMLPart As Office.CustomXMLPart | |
executionXMLPart = GetCustomXmlPart(wkbCurrent, typExecution.SheetCodeName) | |
If Not IsNothing(executionXMLPart) Then | |
executionXMLPart.Delete | |
End If | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment