XML Question - Update Schema/Mapping

[KMKfan]

I am trying to find a way to use VBA to update XML mapping when I need to add to a given schema/mapping. I am working with Excel 2007 (basically looking for an equivalent to the Excel 2003 XML Toolbox.) Basically, I want to be able to have a XML Schema with elements A & B as an XML source for my Workbook (I'll call it WB). WB will have Map1 with elements A & B mapped to random cells (ie can be anywhere...not necessarily in Row or Column form). If I need to capture a 3rd piece of data, C (manualy created in my existing schema), how can I replace Map1 with Map2, such that A & B would be mapped to their locations from Map1 (with C needing to be mapped).

I've come across this link:

http://social.msdn.microsoft.com/Forums/en-US/vsto/thread/ed2ddffb-b3f8-47b3-a0b0-31bd55abfcf2

But cannot really figure out the code snippets. Looks like he is calling some functions that were not included in the answer post.

I've been spinning my wheels trying to figure out how to either:

A. Check any UsedRange for an XML Mapping, and finding the name of the Mapping (Root/Parent/Child) and switching that from Map1 to Map2 for that UsedRange

B. Check each element in my Mapping for Map1 (Root/Parent/Child) and returning the range associated with that element. I could then reassign that range with the element in Map2 that matches the same Root/Parent/Child path.


I think part of my hang up is not completely understanding what exactly XPath is, so if someone could explain what that is referring to that would probably be a big help.

 

[KMKfan]

Got it:

First Dim variables

Dim r, c As Integer
Dim wb1, wb2 As Workbook
Dim StrMap, StrWS, StrRng, StrXPath As String
Dim nStrWS, nStrRng, nStrXPath As String
Dim nStrMap As XmlMap

Not sure if I will need to Dim StrMap as XmlMap or Not. I really just put it in as a possible future enhancement in case I ever have multiple maps in a workbook.

Then the calls:

Sub Update_XML()
    Call Get_XPath
    Call Add_NewMap
    Call Assign_Elements
End Sub

For Get_XPath, I have:

Sub Get_XPath()
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Add
wb1.Activate
For Each Sheet In wb1.Sheets
    Range("A1").Select
    For c = 1 To ActiveSheet.UsedRange.Columns.Count
        For r = 1 To ActiveSheet.UsedRange.Rows.Count
            If ActiveCell.XPath <> "" Then Call Send_XPath
            wb1.Activate
            ActiveCell.Offset(1, 0).Select
        Next r
            ActiveCell.Offset(0, 1).Select
            Do Until ActiveCell.Row = 1
                Selection.End(xlUp).Select
            Loop
    Next c
Next Sheet
End Sub

Sub Send_XPath()
    StrWS = ActiveSheet.Name
    StrRng = ActiveCell.Address
    StrXPath = ActiveCell.XPath
    StrMap = ActiveCell.XPath.Map.Name
    With wb2
        .Activate
        ActiveCell = StrMap
        ActiveCell.Offset(0, 1) = StrWS
        ActiveCell.Offset(0, 2) = StrRng
        ActiveCell.Offset(0, 3) = StrXPath
        ActiveCell.Offset(1, 0).Select
    End With
End Sub

This writes the XmlMap, Sheet Name, Range Address, and each mapped cells XPath to a second new workbook. It would probably be better to save them all to some kind of array, but I don't know much about how to program that (I have a new reference book that goes into in pretty good detail...just need to practice). Now I need to get the new schema, and assign the elements.

Sub Add_NewMap()
    ActiveWorkbook.XmlMaps("My_Map").Delete
    ActiveWorkbook.XmlMaps.Add(Application.GetOpenFilename).Name = "My_Map"
End Sub

Sub Assign_Elements()

With wb2
    .Activate
    Application.Goto Range("$A$1")
End With
Do Until ActiveCell = ""
    Set nStrMap = wb1.XmlMaps("Renewal_Map")
    nStrWS = ActiveCell.Offset(0, 1)
    nStrRng = ActiveCell.Offset(0, 2)
    nStrXPath = ActiveCell.Offset(0, 3)
    With wb1
        .Activate
        Sheets(nStrWS).Select
        Range(nStrRng).XPath.SetValue nStrMap, nStrXPath
    End With
        wb2.Activate
        ActiveCell.Offset(1, 0).Select
Loop
    wb2.Close False
End Sub

The GetOpenFileName is where you get the revised schema. Ideally, it would match the existing schema source with a few new elements that you need to map. Where I work, I have a few programs that are modified somewhat regularly, and the XML source should make it easier to view our results in updated versions of our program.

I welcome any changes to the code that will get it to run faster or is structured a little better. It will run in a 3 meg xlsm file with an over/under of about 1000 elements, so any time saved by an improved code would be appreciated. I apologize for lack of commenting in the code...I just finished it and will comment later.

Thanks to everyone who has helped me in the past.

 

[KMKfan]

Oh, and sorry...but I can't figure out how to edit the post subject to read "Solved"

 

[xenou]

[deleted] - OP just posted a solution.

 

[KMKfan]

One more thing...the Add_NewMap code assumes that only one XMLMap is in the workbook. I'll be trying to revamp the code to allow multiple maps in each workbook. If code does not work on your computer, try adding the most recent Microsoft XML References. I'm not sure it is needed, but I did add the reference on my Excel program before I started writing the code.

 

[KMKfan]

Here is an update for this code. This code allows for multiple XML maps to update within the same workbook as long as the xsd and xml map have the same name (ie: the source map "MyMap" is based on MyMap.xsd. Should be very helpful if you are using XML to assist in reporting and decide to add a piece of data to capture. You can update the existing mapping automatically and only have to manually update the new data elements.

Dim r, c As Integer
Dim wb1, wb2 As Workbook
Dim StrMap, StrWS, StrRng, StrXPath As String
Dim nStrWS, nStrRng, nStrXPath As String
Dim nStrMap As XmlMap

Sub Update_XML()
    Call Get_XPath
    Call Add_NewMap
    Call Assign_Elements
End Sub

Sub Get_XPath()
'Gets Available XML Mappings (XPath) for current workbook and sends the text information to a temp file.
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Add
wb1.Activate
For Each Sheet In wb1.Sheets
Sheet.Select
    Range("A1").Select
    Selection.UnMerge
    For c = 1 To ActiveSheet.UsedRange.Columns.Count
        For r = 1 To ActiveSheet.UsedRange.Rows.Count
            If ActiveCell.Offset(r - 1, c - 1).XPath <> "" Then Call Send_XPath
            wb1.Activate
        Next r
    Next c
    Selection.Merge
Next Sheet

End Sub

Sub Send_XPath()
'Sends text information to a temporary workbook for use later.
    StrWS = ActiveSheet.Name
    StrRng = ActiveCell.Offset(r - 1, c - 1).Address
    StrXPath = ActiveCell.Offset(r - 1, c - 1).XPath
    StrMap = ActiveCell.Offset(r - 1, c - 1).XPath.Map.Name
    With wb2
        .Activate
        ActiveCell = StrMap
        ActiveCell.Offset(0, 1) = StrWS
        ActiveCell.Offset(0, 2) = StrRng
        ActiveCell.Offset(0, 3) = StrXPath
        ActiveCell.Offset(1, 0).Select
    End With
End Sub

Sub Add_NewMap()
'Delete the current XML map and add a new XML Map that has the same schema structure.
'XML Map and XSD schema must be named identically.  Only the .xsd extension should be different.
Dim MyPath, MyMap As String
MyPath = 'Path of .xsd file goes here
    For Each XmlMap In wb1.XmlMaps
        MyMap = XmlMap.Name
        wb1.XmlMaps(XmlMap.Name).Delete
        wb1.XmlMaps.Add(MyPath & "\" & MyMap & ".xsd").Name = MyMap
    Next XmlMap
End Sub

Sub Assign_Elements()
'Assign XPath of new XML Map to ranges based on the information in the temp workbook.  Close 2nd workbook w/o saving.
With wb2
    .Activate
    Application.Goto Range("$A$1")
End With
Do Until ActiveCell = ""
    Set nStrMap = wb1.XmlMaps(ActiveCell.Text)
    nStrWS = ActiveCell.Offset(0, 1)
    nStrRng = ActiveCell.Offset(0, 2)
    nStrXPath = ActiveCell.Offset(0, 3)
    With wb1
        .Activate
        Sheets(nStrWS).Select
        Range(nStrRng).XPath.SetValue nStrMap, nStrXPath
    End With
        wb2.Activate
        ActiveCell.Offset(1, 0).Select
Loop
    wb2.Close False
End Sub