?
Solved

Excel to XML macro

Posted on 2011-03-15
8
Medium Priority
?
681 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
More Than Just A Video Library

Train for your certification. Learn the latest DevOps tools. Grow your skillset to do better work.

At Linux Academy, we release new training modules every week so you'll always be up to date on the latest tech.

 
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 1400 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 600 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

Quick Start: DOCKER

Sometimes you just need a Quick Start on a topic in order to begin using it.. this is just what you need to know to get up and running with Docker!

Question has a verified solution.

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

How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

762 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