Excel to XML macro

Hi,

I have a macro that extracts unique text out of a folder of XML files.

We translate the content into a different language in a separate column. and now I need to take each tab in the spreadsheet, locate the matching XML file (tabname.xml) and replace every instance of the text in column B with the text in Column C in the XML file, then save and close the file.

Is this easy to do? Still with an Excel macro? It's basically an automation of a global find and replace operation using Column B to match and Column C to replace the value that matches Column B.

I've attached a zip file of the spreadsheet and the two XML files that would need to be altered and pasted the code from the original Macro for reference (not sure it is relevant at all to this reverse operation)

Thanks

Bill Excel-to-XML-samples.zip

Related question: http:Q_26888839.html
Private Sub CommandButton1_Click()
    Dim strPath As String, strCurrentFile As String
    Dim MyData As String, strData() As String, strFile As String
    Dim temp() As String
    Dim I As Long, LastRow As Long
    Dim ws As Worksheet
    
    '~~> Change the path to the folder where the XML's are stored
    strPath = "C:\Temp\"
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    strCurrentFile = Dir(strPath & "c*.xml")
    
    '~~> Loop through the folder to get the xml files
    Do While strCurrentFile <> ""
        strFile = strPath & strCurrentFile
        
        Set ws = Sheets.Add
        ws.Name = Replace(strCurrentFile, ".xml", "", , , vbTextCompare)
        ws.Range("A1") = "File"
        ws.Range("B1") = "Text"
        
        '~~> Open XML as binary for faster reading in one go
        Open strFile For Binary As #1
        MyData = Space$(LOF(1))
        Get #1, , MyData
        Close #1
        
        '~~> Split the data and store it in an array
        strData() = Split(MyData, vbCrLf)
        
        '~~> Get the next available row
        LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
        
        '~~> Generate output WITH DUPLICATES
        For I = 0 To UBound(strData())
            If InStr(strData(I), "<node template=") Then
                temp = Split(strData(I), """")
                ws.Range("A" & LastRow) = strFile
                ws.Range("B" & LastRow) = temp(3)
                LastRow = LastRow + 1
            End If
        Next
        
        LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
        
        '~~> Remove DUPLICATES
        ws.Range("$A$1:$B$" & LastRow).RemoveDuplicates Columns:=Array(1, 2), Header _
        :=xlYes
        
        ws.Cells.EntireColumn.AutoFit
        
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
    
        strCurrentFile = Dir
    Loop
End Sub

Open in new window

LVL 1
billium99Asked:
Who is Participating?
 
Simon BallConnect With a Mentor Commented:
doh!
change line 48 to this. and remove line 44

        Print #2, MyData

 
Public Sub update()

Dim wsheet As Worksheet
Dim wbook As Workbook

strPath = "C:\Documents and Settings\sball\My Documents\EE\XML-to-Excel-samples\"
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
Dim newFile As String


Set wbook = Application.ActiveWorkbook
For Each wsheet In wbook.Worksheets
wsheet.Activate
    strCurrentFile = Dir(strPath & wsheet.Name & ".xml")
newFile = strPath & wsheet.Name & "_trans.xml"
strFile = strPath & strCurrentFile
' get data in
Open strFile For Binary As #1
        MyData = Space$(LOF(1))
        Get #1, , MyData
        Close #1

strFile = newFile
'get dataset to use for find and replaces
'MsgBox wsheet.UsedRange.AddressLocal
LastRow = wsheet.Range("A" & Rows.Count).End(xlUp).Row
firstrow = 2
For j = firstrow To LastRow
fndcell = "B" & j
repcell = "C" & j
'MyData = Replace(MyData, wsheet.Range("B2").Value, wsheet.Range("C2").Value, 1, -1)
MyData = Replace(MyData, wsheet.Range(fndcell).Value, wsheet.Range(repcell).Value, 1, -1)
Next


'write output file
Open strFile For Output As #2
        'MyData = Space$(LOF(1))
        Print #2, MyData
        Close #2

Next


End Sub

Open in new window

0
 
Simon BallCommented:
So you need to open the xml file for update,

read each line, and for each line, use find and replace to look for
each value in column b and replace it with the relevant item in column c.


0
 
Simon BallCommented:
in the framework of your existing macro i have added a new macro using mostly bits from your original code.

i have used google to trnaslate the sheet and added these as column c.

you will need to change the cid in your other code to column d?

the replace macro creates a new file called worksheetname_trans with the updated data

the final problem i am working on, the trans file seems to contain double quotes... but the variable mydata does not...
what-Im-hoping-to-get.xlsm
0
Cloud Class® Course: Amazon Web Services - Basic

Are you thinking about creating an Amazon Web Services account for your business? Not sure where to start? In this course you’ll get an overview of the history of AWS and take a tour of their user interface.

 
Simon BallCommented:
0
 
Simon BallCommented:
Public Sub update()

Dim wsheet As Worksheet
Dim wbook As Workbook

strPath = "C:\Documents and Settings\sball\My Documents\EE\XML-to-Excel-samples\"
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
Dim newFile As String


Set wbook = Application.ActiveWorkbook
For Each wsheet In wbook.Worksheets
wsheet.Activate
    strCurrentFile = Dir(strPath & wsheet.Name & ".xml")
newFile = strPath & wsheet.Name & "_trans.xml"
strFile = strPath & strCurrentFile
' get data in
Open strFile For Binary As #1
        MyData = Space$(LOF(1))
        Get #1, , MyData
        Close #1

strFile = newFile
'get dataset to use for find and replaces
'MsgBox wsheet.UsedRange.AddressLocal
LastRow = wsheet.Range("A" & Rows.Count).End(xlUp).Row
firstrow = 2
For j = firstrow To LastRow
fndcell = "B" & j
repcell = "C" & j
'MyData = Replace(MyData, wsheet.Range("B2").Value, wsheet.Range("C2").Value, 1, -1)
MyData = Replace(MyData, wsheet.Range(fndcell).Value, wsheet.Range(repcell).Value, 1, -1)
Next

Dim sng As String
Dim dbl As String

sng = Left("""", 1)
dbl = Left("""", 1) & Left("""", 1)
' error noticed in final file "" everywhere
MyData = Replace(MyData, dbl, sng, 1, -1)
'write output file
Open strFile For Output As #2
        'MyData = Space$(LOF(1))
        Write #2, MyData
        Close #2

Next


End Sub

Open in new window


here is the code..
0
 
Simon BallCommented:
0
 
JezWaltersConnect With a Mentor Commented:
Looks like I'm a bit late with this, but I had the following:
Public Sub TranslateText()

    ' Declare constants
    Const PATH As String = "C:\CQEE\LAR Logic Flows\test\"  ' XML file path

    ' Declare variables
    Dim intFile As Integer               ' File handle
    Dim lngRow As Long                   ' Row
    Dim strData As String                ' XML Data
    Dim strFile As String                ' File
    Dim wksWorksheet As Excel.Worksheet  ' Worksheet

    ' Process worksheets
    For Each wksWorksheet In Application.Worksheets

        ' Read XML file
        strFile = PATH & wksWorksheet.Name & ".xml"
        intFile = FreeFile
        Open strFile For Binary Access Read As #intFile
        strData = Input(LOF(intFile), #intFile)
        Close #intFile

        ' Replace text
        For lngRow = 2 To wksWorksheet.UsedRange.Rows.Count
            strData = Replace(strData, wksWorksheet.Range("B" & lngRow), wksWorksheet.Range("C" & lngRow))
        Next

        ' Write XML file
        Kill strFile  ' Delete previous file
        intFile = FreeFile
        Open strFile For Binary Access Write As intFile
        Put #intFile, , strData
        Close #intFile
    Next
End Sub

Open in new window

0
 
billium99Author Commented:
Thanks for the help guys!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.