How to copy xml mapping from one workbook to another workbook?

This Excel 2003 VBA code applies XML mapping of one Excel workbook to another workbook.


Sub remap()
'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 = Workbooks("xml_mapped_excel_workbook.xls")
'apply xml mapping to this workbook:
Set Workbook_To = Workbooks("not_xml_mapped_excel_workbook.xls")
Debug.Print Workbook_To.XmlMaps.Item(1)
Set currentMap = Workbook_To.XmlMaps.Item(1)
On Error Resume Next
Application.DisplayAlerts = False
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