Sub ExportToXML()
Dim Filename As Range
Dim FSO As Object
Dim XML As Object
Dim v, x, i As Integer, s As String
Set FSO = CreateObject("Scripting.FileSystemObject")
With ActiveSheet
For Each Filename In .Range("B2:B" & GetLastRow("Sheet1"))
Set XML = FSO.CreateTextFile( _
Filename:=ThisWorkbook.Path & "\" & Filename.Value & ".xml", _
Overwrite:=True)
With Filename
XML.WriteLine ("<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>")
XML.WriteLine (" <File>")
''XML.WriteLine (" <Date>" & .Offset(0, -1).Value & "</Date>")
v = Split(.Offset(, -1).Text, "T")
x = Split(v(1), ":")
s = Empty
For i = LBound(x) To UBound(x)
s = s & IIf(s > Empty, ":", Empty) & Format(Replace(x(i), "Z", ""), "00")
Next i
XML.WriteLine (" <Date>" & v(0) & "T" & s & "Z" & "</Date>")
XML.WriteLine (" <FileName>" & .Value & "</FileName>")
XML.WriteLine (" <FileExtension>" & .Offset(0, 1).Value & "</FileExtension>")
XML.WriteLine (" <Title>" & .Offset(0, 2).Value & "</Title>")
XML.WriteLine (" <Mappings>")
XML.WriteLine (" <Mapping>")
XML.WriteLine (" <RICCode>" & .Offset(0, 3).Value & "</RICCode>")
XML.WriteLine (" <SEDOL>" & .Offset(0, 4).Value & "</SEDOL>")
XML.WriteLine (" <ISIN>" & .Offset(0, 5).Value & "</ISIN>")
XML.WriteLine (" <BBGTicker>" & .Offset(0, 6).Value & "</BBGTicker>")
XML.WriteLine (" </Mapping>")
XML.WriteLine (" </Mappings>")
XML.WriteLine (" </File>")
End With
XML.Close
Next Filename
End With
Set XML = Nothing
Set FSO = Nothing
End Sub
Function GetLastRow(wkSheet As String) As Long
With Worksheets(wkSheet)
GetLastRow = .Cells.Find( _
What:="*", _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End With
End Function