Excel XML Map Problems

Question

I have a workbook with an XML map of about 100 fields.

Whether I copy/paste the rows into a new workbook or copy the sheet to a new workbook, the XML mapping is lost.

Ideas why? TIA

Answer 1

Nevermind, I found a macro on expertsexchange and modified it slightly, for those who need this solution use the code below.

The first wb opened has xml maps, the second wb opened gets the copied maps

Option Explicit

Sub remap()

Dim wb1 As Workbook, wb2 As Workbook

With Application.FileDialog(msoFileDialogOpen)

    .Show

    .Execute

End With

Set wb1 = ActiveWorkbook

With Application.FileDialog(msoFileDialogOpen)

    .Show

    .Execute

End With

Set wb2 = ActiveWorkbook

'this functions iterates trough mapped workbook (workbook_from) and

'applies same XML mapping to identical cells of not mapped workbook (workbook_to)

'XML map file must be added to Workbook_To before running this code

Dim Workbook_From, Workbook_To As Workbook

Dim currentMap As XmlMap

Dim rCell As Range

'get xml mapping of this workbook:

Set Workbook_From = wb1

'apply xml mapping to this workbook:

Set Workbook_To = wb2

Debug.Print Workbook_To.XmlMaps.Item(1)

Set currentMap = Workbook_To.XmlMaps.Item(1)

On Error Resume Next

Application.DisplayAlerts = False

Dim wsheet As Worksheet

For Each wsheet In Workbook_From.Worksheets

RemoveAllXMLMappings Workbook_To.Worksheets(wsheet.Name)

For Each rCell In wsheet.UsedRange.Cells

If rCell.XPath <> "" Then

Workbook_To.Worksheets(wsheet.Name).Range(rCell.Address).XPath.SetValue currentMap, rCell.XPath

End If

Next rCell

DoEvents

Next wsheet

End Sub

Sub RemoveAllXMLMappings(wks As Worksheet)

Dim rCell As Range

For Each rCell In wks.UsedRange.Cells

If rCell.XPath <> "" Then

rCell.XPath.Clear

End If

Next

End Sub