Solved

Excel to XML macro

Posted on 2011-03-15
8
671 Views
Last Modified: 2012-05-11
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

0
Comment
Question by:billium99
  • 6
8 Comments
 
LVL 15

Expert Comment

by:Simon Ball
ID: 35146161
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
 
LVL 15

Expert Comment

by:Simon Ball
ID: 35146368
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
 
LVL 15

Expert Comment

by:Simon Ball
ID: 35146371
0
Master Your Team's Linux and Cloud Stack

Come see why top tech companies like Mailchimp and Media Temple use Linux Academy to build their employee training programs.

 
LVL 15

Expert Comment

by:Simon Ball
ID: 35146405
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
 
LVL 15

Accepted Solution

by:
Simon Ball earned 350 total points
ID: 35146441
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
 
LVL 15

Expert Comment

by:Simon Ball
ID: 35146444
0
 
LVL 17

Assisted Solution

by:JezWalters
JezWalters earned 150 total points
ID: 35146788
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
 
LVL 1

Author Closing Comment

by:billium99
ID: 35160083
Thanks for the help guys!
0

Featured Post

Master Your Team's Linux and Cloud Stack

Come see why top tech companies like Mailchimp and Media Temple use Linux Academy to build their employee training programs.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

831 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question