Create xml for each row for excel file

JAVEDR

Board Regular
Joined
Sep 17, 2019
Messages
79
Office Version
  1. 2019
Platform
  1. Windows
  2. Mobile
  3. Web
Respected sir / mam, i am looking for automation or macro to generate xml for each row please find attached excel file where date is paste and seperate .xml file which need to be generated

seperate xml file & excel file path

thanking you for valuable time & feedback.
 
Note that the lines put after this line of code
VBA Code:
 xml.WriteLine ("    <File>")

Review the post and you will find that I put this line as guideline for you
 
Upvote 0

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
This is the whole code
VBA Code:
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
 
Upvote 0
This is the whole code
VBA Code:
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

thanks sir, code works perfect ..
 
Upvote 0
This will work

VBA Code:
XML.WriteLine ("        <Date>" & Format(.Offset(0, -1).Value, "yyyy-mm-ddThh:mm:ssZ") & "</Date>")

VBA Code:
Sub ExportToXML()

    Dim Filename As Range
    Dim FSO As Object
    Dim XML As Object
    
    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>" & Format(.Offset(0, -1).Value, "yyyy-mm-ddThh:mm:ssZ") & "</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
 
Upvote 0
This will work

VBA Code:
XML.WriteLine ("        <Date>" & Format(.Offset(0, -1).Value, "yyyy-mm-ddThh:mm:ssZ") & "</Date>")

VBA Code:
Sub ExportToXML()

    Dim Filename As Range
    Dim FSO As Object
    Dim XML As Object
   
    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>" & Format(.Offset(0, -1).Value, "yyyy-mm-ddThh:mm:ssZ") & "</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

Thanks a lot sir, it works perfect any reason why it creates 1 blank xml as well.
 

Attachments

  • 123.jpg
    123.jpg
    43.1 KB · Views: 26
Upvote 0
Thanks a lot sir, it works perfect any reason why it creates 1 blank xml as well.

There could be something in a cell somewhere in the row below where your last filename is.

Here's another version of the GetLastRow function that should sort that out
VBA Code:
Function GetLastRow(wkSheet As String, refCol As String) As Long

    With Worksheets(wkSheet)
        GetLastRow = .Cells(.Rows.Count, refCol).End(xlUp).Row
    End With

End Function

Full code
VBA Code:
Sub ExportToXML()

    Dim Filename As Range
    Dim FSO As Object
    Dim XML As Object
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
   
    With ActiveSheet
        For Each Filename In .Range("B2:B" & GetLastRow("Sheet1", "B"))
            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>" & Format(.Offset(0, -1).Value, "yyyy-mm-ddThh:mm:ssZ") & "</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, refCol As String) As Long

    With Worksheets(wkSheet)
        GetLastRow = .Cells(.Rows.Count, refCol).End(xlUp).Row
    End With

End Function
 
Upvote 0
There could be something in a cell somewhere in the row below where your last filename is.

Here's another version of the GetLastRow function that should sort that out
VBA Code:
Function GetLastRow(wkSheet As String, refCol As String) As Long

    With Worksheets(wkSheet)
        GetLastRow = .Cells(.Rows.Count, refCol).End(xlUp).Row
    End With

End Function

Full code
VBA Code:
Sub ExportToXML()

    Dim Filename As Range
    Dim FSO As Object
    Dim XML As Object
  
    Set FSO = CreateObject("Scripting.FileSystemObject")
  
    With ActiveSheet
        For Each Filename In .Range("B2:B" & GetLastRow("Sheet1", "B"))
            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>" & Format(.Offset(0, -1).Value, "yyyy-mm-ddThh:mm:ssZ") & "</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, refCol As String) As Long

    With Worksheets(wkSheet)
        GetLastRow = .Cells(.Rows.Count, refCol).End(xlUp).Row
    End With

End Function

i have tried above code sir, still it create blank xml.
 
Upvote 0
Excellent work on this code. It was very close to what I needed


This is the whole code
VBA Code:
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
 
Upvote 0
All - Excellent work on this string and searching the forum is a great resource. I've been able to reuse this for my project, however, I am having difficulty getting the "Next Filename" to work. My Excel file will have several rows of data, which I need all of those XML records in one file. I swapped the placement of XML.Close and Next Filename and it gave me only the last row in the XML output file. I'm guessing it did loop through all the records, but with the overwrite being set to true. When I set it to False, I get an error "File Already Exists". Is there a way to adjust the code so it will write multiple lines of data into 1 XML output file?
 
Upvote 0
All - Posting this to let everyone know I have figured out the error I was receiving so that no one else spends time devising a solution unless they want to. However, for everyone's benefit, the looping issue was fairly simple as I had written in some code (specific to my requirements outside of the project defined in this string) that was causing the error and break the macro from writing out more than one row of data to the file. I simply moved that code outside of the "For Each Filename in .Range" statement and it worked. I was looking at the end of the loop, thinking that's where the error was, but I didn't think to look at the beginning of the loop to make sure that was fine until I stepped away from it a bit.
 
Upvote 0

Forum statistics

Threads
1,223,909
Messages
6,175,310
Members
452,634
Latest member
cpostell

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top