Solved

Excel to XML macro

Posted on 2011-03-15
8
673 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
MIM Survival Guide for Service Desk Managers

Major incidents can send mastered service desk processes into disorder. Systems and tools produce the data needed to resolve these incidents, but your challenge is getting that information to the right people fast. Check out the Survival Guide and begin bringing order to chaos.

 
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

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

726 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