Create xml for each row for excel file

J

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.
 
Sort by date Sort by votes
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

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
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
YasserKhalil said:
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
Click to expand...

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
juddaaaa said:
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
Click to expand...

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
JAVEDR said:
Thanks a lot sir, it works perfect any reason why it creates 1 blank xml as well.
Click to expand...

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
juddaaaa said:
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
Click to expand...

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


YasserKhalil said:
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
Click to expand...
 
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
You must log in or register to reply here.

Similar threads

S
  • Solved
For each row, create new folder based on single cell value, then save exported XML doc to matching folder.
Replies
3
Views
703
shand
S
I
  • Solved
VBA help to open .txt files and copy into its respective sheet
2
Replies
15
Views
253
ItalianPlatinum
I
S
  • Solved
Macro not saving exported files to where it should
Replies
2
Views
544
shand
S
D
  • Question Question
creat columns of text inside xml files in excell
Replies
0
Views
518
Dpalkon
D
C
  • Question Question
Copy, paste, change name of file.
Replies
2
Views
119
Skyybot
Skyybot

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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