Tranforms an classification stored in Excel to Aras Item classification

ExcelToClassification.vb

' source columns are from 6 to 10 and are ordered alphabetically starting on col 6 to 10.

Sub ListToClassStructure()

Dim colStart As String
colStart = "f"

Dim i As Integer
i = 2

Dim C6 As String
Dim C7 As String
Dim C8 As String
Dim C9 As String
Dim C10 As String


Dim outputString As String
outputString = "<class><class name=" & Chr(34) & Me.Cells(i, 6) & Chr(34) & " > "
outputString = outputString & "<class name=" & Chr(34) & Me.Cells(i, 7) & Chr(34) & " > "
outputString = outputString & "<class name=" & Chr(34) & Me.Cells(i, 8) & Chr(34) & " > "
outputString = outputString & "<class name=" & Chr(34) & Me.Cells(i, 9) & Chr(34) & " > "
outputString = outputString & "<class name=" & Chr(34) & Me.Cells(i, 10) & Chr(34) & "></class>"

i = 3

While (Me.Cells(i, 6) <> "")
    C6 = Replace(Me.Cells(i, 6), "&", "&amp;", 1, -1, vbTextCompare)
    C7 = Replace(Me.Cells(i, 7), "&", "&amp;", 1, -1, vbTextCompare)
    C8 = Replace(Me.Cells(i, 8), "&", "&amp;", 1, -1, vbTextCompare)
    C9 = Replace(Me.Cells(i, 9), "&", "&amp;", 1, -1, vbTextCompare)
    C10 = Replace(Me.Cells(i, 10), "&", "&amp;", 1, -1, vbTextCompare)
    
     C6 = Replace(C6, "<", "&lt;", 1, -1, vbTextCompare)
    C7 = Replace(C7, "<", "&lt;", 1, -1, vbTextCompare)
    C8 = Replace(C8, "<", "&lt;", 1, -1, vbTextCompare)
    C9 = Replace(C9, "<", "&lt;", 1, -1, vbTextCompare)
    C10 = Replace(C10, "<", "&lt;", 1, -1, vbTextCompare)
    
    C6 = Replace(C6, ">", "&gt;", 1, -1, vbTextCompare)
    C7 = Replace(C7, ">", "&gt;", 1, -1, vbTextCompare)
    C8 = Replace(C8, ">", "&gt;", 1, -1, vbTextCompare)
    C9 = Replace(C9, ">", "&gt;", 1, -1, vbTextCompare)
    C10 = Replace(C10, ">", "&gt;", 1, -1, vbTextCompare)
    
    C6 = Replace(C6, "/", " ")
    C7 = Replace(C7, "/", " ")
    C8 = Replace(C8, "/", " ")
    C9 = Replace(C9, "/", " ")
    C10 = Replace(C10, "/", " ")
    
    If (Me.Cells(i, 6) <> Me.Cells(i - 1, 6)) Then
        outputString = outputString + "</class></class></class></class><class name=" & Chr(34) & C6 & Chr(34) & ">"
        outputString = outputString + "<class name=" + Chr(34) + C7 + Chr(34) + ">"
        outputString = outputString + "<class name=" + Chr(34) + C8 + Chr(34) + ">"
        outputString = outputString + "<class name=" + Chr(34) + C9 + Chr(34) + ">"
        outputString = outputString + "<class name=" + Chr(34) + C10 + Chr(34) + "></class>"
    Else
        If (Me.Cells(i, 7) <> Me.Cells(i - 1, 7)) Then
            outputString = outputString + "</class></class></class><class name=" + Chr(34) + C7 + Chr(34) + ">"
            outputString = outputString + "<class name=" + Chr(34) + C8 + Chr(34) + ">"
            outputString = outputString + "<class name=" + Chr(34) + C9 + Chr(34) + ">"
            outputString = outputString + "<class name=" + Chr(34) + C10 + Chr(34) + "></class>"
        Else
            If (Me.Cells(i, 8) <> Me.Cells(i - 1, 8)) Then
                outputString = outputString + "</class></class><class name=" + Chr(34) + C8 + Chr(34) + ">"
                outputString = outputString + "<class name=" + Chr(34) + C9 + Chr(34) + ">"
                outputString = outputString + "<class name=" + Chr(34) + C10 + Chr(34) + "></class>"
            Else
                If (Me.Cells(i, 9) <> Me.Cells(i - 1, 9)) Then
                    outputString = outputString + "</class><class name=" + Chr(34) + C9 + Chr(34) + ">"
                    outputString = outputString + "<class name=" + Chr(34) + C10 + Chr(34) + "></class>"
                Else
                    outputString = outputString + "<class name=" + Chr(34) + C10 + Chr(34) + "></class>"
                End If
            End If
        End If
    End If
    i = i + 1
Wend

' saving the xml into a file
Dim myTempFile As String
myTempFile = Application.DefaultFilePath & "\classification_temp.xml"
Open myTempFile For Output As #1
Write #1, outputString
Close #1


outputString = outputString + "</class></class></class></class></class>"
outputString = Replace(outputString, "&", "&amp;")
outputString = Replace(outputString, "<", "&lt;")
outputString = Replace(outputString, ">", "&gt;")


' saving the xml into a file
Dim myFile As String
myFile = Application.DefaultFilePath & "\classification.xml"
Open myFile For Output As #1
Write #1, outputString
Close #1

End Sub