Search code examples
xmlexcelxmlmappervba

Excel 2013 - VBA XML binding broken on restart

I have complex XSD. In excel developer, in XML section I can click on "source" and add XSD to datasource map, then map nodes to specific cells, rows, etc.

I can then enter data and export XML as expected, nice. When I reopen saved XLS something weird happens and excel says that my XML map is broken and asks to remove broken map and shows one node that he thinks is wrong. But all the options are grayed and the only option I found is to remove the map via VBA, 

ActiveWorkbook.XmlMaps("JPK_mapa").Delete

But when map is removed all mappings are gone and I have to add map again and do all the mappings manually. It is not difficult to me, but ordinary users can have problems with that and I'd like to just give them XLS to fill with the data.

I can't change XSD, have no influence on its contents so I assumed that I have to live with that and teach excel somehow to remove and add this mapping again on autostart. As there are a lot of mappings, and it is just a few clicks in excel, I'd love to record this as a macro. But when I turn on recording it does not record mappings I do.

Q1: Is there any way I can record mapping generation? Or is there a way to automate that process somehow?

I also found out interesting thing. If I open my map-broken xlsx as zip and remove xmlMaps.xml from within it, after opening xls again I can open XML datasource and when I add my xsd all the mappings are recovered and bond properly to cells in xls (marked as bold in attached pic). This leads me to asking question 2.

Q2: Is there a way I can remove the mappings in VBA in the way that when added again it would remember the mappings?

Hope you can give me some advice, thanks.

part of XSD

Solution

  • I found solution to the problem. Not exactly the way I expected, but is working fine. What I do is rebuilding the map when the excel file is opened. I save the mapping of the fields to the schema in separate hidden worksheet, and when the file is opened I delete old schema, add new one and add the mapping. The process is transparent to the user.

        Private Sub Auto_Open()
        Dim myMap As XmlMap

        ActiveWorkbook.XmlMaps(1).Delete
        Set myMap = ActiveWorkbook.XmlMaps.Add(Application.ActiveWorkbook.Path & "\JPK_VAT2v1-0.xsd", "JPK")
        myMap.Name = "JPK_mapa"



     A = True
     row = 1
     While A
        If (Worksheets("Maps").Range("A" & row).Value <> "") Then

            mySheet = Worksheets("Maps").Range("A" & row).Value
            mycell = Worksheets("Maps").Range("B" & row).Value
            myXpath = Worksheets("Maps").Range("D" & row).Value
            ret = Worksheets(mySheet).Range(mycell).XPath.SetValue(myMap, myXpath)
            row = row + 1

        Else
            A = False
        End If
     Wend
     End Sub

    and Maps worksheet looks like below:

        ColA    ColB    ColC        ColD

    Start   $B$2    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:KodFormularza
    Start   $C$2    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:KodFormularza/@kodSystemowy
    Start   $D$2    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:KodFormularza/@wersjaSchemy
    Start   $E$2    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:WariantFormularza
    Start   $F$2    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:CelZlozenia
    Start   $G$2    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:DataWytworzeniaJPK
    Start   $H$2    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:DataOd
    Start   $I$2    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:DataDo
    Start   $J$2    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:DomyslnyKodWaluty
    Start   $K$2    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:KodUrzedu
    Start   $B$5    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:IdentyfikatorPodmiotu/ns2:NIP
    Start   $C$5    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:IdentyfikatorPodmiotu/ns2:PelnaNazwa
    Start   $D$5    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:IdentyfikatorPodmiotu/ns2:REGON
    Start   $E$5    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:KodKraju
    Start   $F$5    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:Wojewodztwo
    Start   $G$5    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:Powiat
    Start   $H$5    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:Gmina
    Start   $I$5    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:Ulica
    Start   $J$5    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:NrDomu
    Start   $K$5    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:NrLokalu
    Start   $L$5    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:Miejscowosc
    Start   $M$5    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:KodPocztowy
    Start   $N$5    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:Poczta
    Sprzedaz    $B$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/@typ
    Sprzedaz    $C$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:LpSprzedazy
    Sprzedaz    $D$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:NrKontrahenta
    Sprzedaz    $E$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:NazwaKontrahenta
    Sprzedaz    $F$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:AdresKontrahenta
    Sprzedaz    $G$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:DowodSprzedazy
    Sprzedaz    $H$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:DataWystawienia
    Sprzedaz    $I$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:DataSprzedazy
    Sprzedaz    $J$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_10
    Sprzedaz    $K$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_11
    Sprzedaz    $L$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_12
    Sprzedaz    $M$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_13
    Sprzedaz    $N$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_14
    Sprzedaz    $O$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_15
    Sprzedaz    $P$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_16
    Sprzedaz    $Q$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_17
    Sprzedaz    $R$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_18
    Sprzedaz    $S$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_19
    Sprzedaz    $T$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_20
    Sprzedaz    $U$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_21
    Sprzedaz    $V$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_22
    Sprzedaz    $W$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_23
    Sprzedaz    $X$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_24
    Sprzedaz    $Y$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_25
    Sprzedaz    $Z$1    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_26
    Sprzedaz    $AA$1   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_27
    Sprzedaz    $AB$1   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_28
    Sprzedaz    $AC$1   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_29
    Sprzedaz    $AD$1   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_30
    Sprzedaz    $AE$1   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_31
    Sprzedaz    $AF$1   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_32
    Sprzedaz    $AG$1   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_33
    Sprzedaz    $AH$1   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_34
    Sprzedaz    $AI$1   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_35
    Sprzedaz    $AJ$1   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_36
    Sprzedaz    $AK$1   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_37
    Sprzedaz    $AL$1   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_38
    Sprzedaz    $AM$1   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_39
    SprzedazCTRL    $B$2    JPK_mapa    /ns1:JPK/ns1:SprzedazCtrl/ns1:LiczbaWierszySprzedazy
    SprzedazCTRL    $C$2    JPK_mapa    /ns1:JPK/ns1:SprzedazCtrl/ns1:PodatekNalezny
    Zakup   $B$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/@typ
    Zakup   $C$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:LpZakupu
    Zakup   $D$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:NrDostawcy
    Zakup   $E$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:NazwaDostawcy
    Zakup   $F$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:AdresDostawcy
    Zakup   $G$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:DowodZakupu
    Zakup   $H$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:DataZakupu
    Zakup   $I$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:DataWplywu
    Zakup   $J$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_43
    Zakup   $K$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_44
    Zakup   $L$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_45
    Zakup   $M$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_46
    Zakup   $N$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_47
    Zakup   $O$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_48
    Zakup   $P$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_49
    Zakup   $Q$1    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_50
    ZakupCTRL   $B$2    JPK_mapa    /ns1:JPK/ns1:ZakupCtrl/ns1:LiczbaWierszyZakupow
    ZakupCTRL   $C$2    JPK_mapa    /ns1:JPK/ns1:ZakupCtrl/ns1:PodatekNaliczony

    I also wrote small function to make Maps worksheet based on what is actually mapped so I don't have to manually write contents of the Maps worksheet. This is based on the way I stored mapped fields in my excel file and worksheets, but I think it should shade some light on how can this be achieved, maybe somebody finds it useful :-) So, when I change some mappings I just run manually makeMap function and Maps worksheet is generated.

        Sub makeMap()
        mapRow = store("Start", 2, 1)
        mapRow = store("Start", 5, mapRow)
        mapRow = store("Sprzedaz", 1, mapRow)
        mapRow = store("SprzedazCTRL", 2, mapRow)
        mapRow = store("Zakup", 1, mapRow)
        mapRow = store("ZakupCTRL", 2, mapRow)
    End Sub

    Function store(Sh As String, row As Integer, ByVal mapRow As Integer) As Integer


        Dim mySheet As Worksheet
        Set mySheet = Worksheets(Sh)


        myRow = row
        mycell = ""

        For cols = 2 To 50
        hasXpath = mySheet.Cells(row, cols).XPath

        If Not hasXpath = Empty Then

            Worksheets("Maps").Range("A" & mapRow).Value = Sh
            Worksheets("Maps").Range("B" & mapRow).Value = mySheet.Cells(row, cols).Address
            Worksheets("Maps").Range("C" & mapRow).Value = mySheet.Cells(row, cols).XPath.Map
            Worksheets("Maps").Range("D" & mapRow).Value = mySheet.Cells(row, cols).XPath
            mapRow = mapRow + 1
       End If



       Next cols
       store = mapRow
    End Function