Solved

Excel to XML macro

Posted on 2011-03-15
8
668 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
 
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
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
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

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now