Visual Basic

Public Sub editXML()
'To use this add a com reference to MS XML, V6 from Tools References menu

'Create a new XML DOM Document
Dim xmlfile As New DOMDocument

'Load the xml data from file
xmlfile.Load ("c:\users\dave auld\desktop\test.xml")

'Do what you want to do with the XML file

End Sub

Function fGenerateXML(rngData As Range, rootNodeName As String, sn As Integer, ts As Integer) As String
On Error Resume Next
'===============================================================
' XML Tags
' Table

Const HEADER As String = "<?xml version=""1.0""?>"
Dim TAG_BEGIN As String
Dim TAG_END As String
'Dim strTAG_END As String
Const NODE_DELIMITER As String = "/"


'===============================================================

Dim intColCount As Integer
Dim intRowCount As Integer
Dim intColCounter As Integer
Dim intRowCounter As Integer


Dim rngCell As Range


Dim strXML As String
'Dim str As String
'str = ""
'strTAG_END = ""


' Initial table tag...
Dim rNode() As String
rNode = Split(rootNodeName, NODE_DELIMITER)

If sn = 0 Then
TAG_BEGIN = vbCrLf & "<" & rNode(0) & ">" & vbCrLf & "<" & rNode(1) & ">"
Else
TAG_BEGIN = vbCrLf & "<" & rNode(1) & ">" & vbCrLf
End If

'determining if it is final sheet for concatenation
If sn = ts Then
TAG_END = vbCrLf & "</" & rNode(1) & ">" & vbCrLf & "</" & rNode(0) & ">"
Else
TAG_END = vbCrLf & "</" & rNode(1) & ">" & vbCrLf
End If

'TAG_BEGIN = vbCrLf & "<" & rootNodeName & ">" & vbCrLf
'TAG_END = vbCrLf & "</" & rootNodeName & ">" & vbCrLf

If sn = 0 Then
strXML = HEADER
End If
strXML = strXML & TAG_BEGIN

With rngData

' Discover dimensions of the data we
' will be dealing with...
intColCount = .Columns.Count

intRowCount = .Rows.Count

Dim strColNames() As String

ReDim strColNames(intColCount)


' First Row is the Field/Tag names
If intRowCount >= 1 Then

' Loop accross columns...
For intColCounter = 1 To intColCount

' Mark the cell under current scrutiny by setting
' an object variable...
Set rngCell = .Cells(1, intColCounter)



' Is the cell merged?..
If Not rngCell.MergeArea.Address = _
rngCell.Address Then

MsgBox ("!! Cell Merged ... Invalid format")
Exit Function


End If

'Sangeetha
strColNames(intColCounter) = rngCell.Text

'loop thro the sheets for header
If rNode(1) = "Actual_Loss_History" Or rNode(1) = "As_If_Loss_History" Then

If strColNames(intColCounter) = "Policy Years" Then
strColNames(intColCounter) = "/Policy_Years"
ElseIf strColNames(intColCounter) = "Loss Descriptions" Then
strColNames(intColCounter) = "/Loss_Descriptions"
ElseIf strColNames(intColCounter) = "Date of Loss" Then
strColNames(intColCounter) = "/Date_of_Loss"
ElseIf strColNames(intColCounter) = "PD Gross Loss" Then
strColNames(intColCounter) = "/PD_Gross_Loss"
ElseIf strColNames(intColCounter) = "TE BI Gross Loss" Then
strColNames(intColCounter) = "/TE_BI_Gross_Loss"
ElseIf strColNames(intColCounter) = "PD Current Value" Then
strColNames(intColCounter) = "/PD_Current_Value"
ElseIf strColNames(intColCounter) = "TE BI Current Value" Then
strColNames(intColCounter) = "/TE_BI_Current_Value"
ElseIf strColNames(intColCounter) = "PD Deductible" Then
strColNames(intColCounter) = "/PD_Deductible"
ElseIf strColNames(intColCounter) = "BI TE Ded" Then
strColNames(intColCounter) = "/BI_TE_Ded"
ElseIf strColNames(intColCounter) = "Adjusted Loss PD" Then
strColNames(intColCounter) = "/Adjusted_Loss_PD"
ElseIf strColNames(intColCounter) = "Adjusted Loss TE BI" Then
strColNames(intColCounter) = "/Adjusted_Loss_TE_BI"
ElseIf strColNames(intColCounter) = "Loss Expectancy" Then
strColNames(intColCounter) = "/Loss_Expectancy"
End If
ElseIf rNode(1) = "Type_of_Policy_Coverage" Then
If strColNames(intColCounter) = "Description" Then
strColNames(intColCounter) = "/Description"
ElseIf strColNames(intColCounter) = "Percentage" Then
strColNames(intColCounter) = "/Percentage"
End If

End If
'Sangeetha

Next

End If

'strXML = strXML & vbCrLf & "<" & str & ">" & vbCrLf

Dim Nodes() As String
Dim NodeStack() As String

If (rNode(1) = "Actual_Loss_History" Or rNode(1) = "As_If_Loss_History") And intRowCount = 1 Then
intRowCount = 11
ElseIf rNode(1) = "Additional_Terms_n_Conditions" And intRowCount = 1 Then
intRowCount = 41
ElseIf (rNode(1) = "BI_Deductible" Or rNode(1) = "Combined_Deductible" Or rNode(1) = "Facultative_Reinsurance" Or rNode(1) = "PD_Deductible" Or rNode(1) = "Policy_Limit_Layer_Participation" Or rNode(1) = "Coverage_Sublimits") And intRowCount = 1 Then
intRowCount = 16
ElseIf rNode(1) = "Endorsements_n_Forms" And intRowCount = 1 Then
intRowCount = 121
ElseIf rNode(1) = "Loss_History_Layer_Penetration" And intRowCount = 1 Then
intRowCount = 6
ElseIf (rNode(1) = "Policy_Period_Effective_Date" Or rNode(1) = "Total_Insured_Value") And intRowCount = 1 Then
intRowCount = 3
ElseIf rNode(1) = "Premium_History" And intRowCount = 1 Then
intRowCount = 201
ElseIf rNode(1) = "Set_Sublimits" And intRowCount = 1 Then
intRowCount = 101
ElseIf rNode(1) = "Type_of_Policy_Coverage" And intRowCount = 1 Then
intRowCount = 4
End If

' Loop down the table's rows
For intColCounter = 1 To intColCount


strXML = strXML & vbCrLf & TABLE_ROW
ReDim NodeStack(0)
' Loop accross columns...
For intRowCounter = 2 To intRowCount

' Mark the cell under current scrutiny by setting
' an object variable...
Set rngCell = .Cells(intRowCounter, intColCounter)


' Is the cell merged?..
If Not rngCell.MergeArea.Address = _
rngCell.Address Then

MsgBox ("!! Cell Merged ... Invalid format")
Exit Function

End If

If rNode(1) = "Actual_Loss_History" Or rNode(1) = "As_If_Loss_History" Then
If strColNames(intColCounter) = "/Policy_Years" Then
strColNames(intColCounter) = "/Policy_Years/Policy_Years-" & (intRowCounter - 1)
ElseIf strColNames(intColCounter) = "/Loss_Descriptions" Then
strColNames(intColCounter) = "/Loss_Descriptions/Loss_Descriptions-" & (intRowCounter - 1)
ElseIf strColNames(intColCounter) = "/Date_of_Loss" Then
strColNames(intColCounter) = "/Date_of_Loss/Date_of_Loss-" & (intRowCounter - 1)
ElseIf strColNames(intColCounter) = "/PD_Gross_Loss" Then
strColNames(intColCounter) = "/PD_Gross_Loss/PD_Gross_Loss-" & (intRowCounter - 1)
ElseIf strColNames(intColCounter) = "/TE_BI_Gross_Loss" Then
strColNames(intColCounter) = "/TE_BI_Gross_Loss/TE_BI_Gross_Loss-" & (intRowCounter - 1)
ElseIf strColNames(intColCounter) = "/PD_Current_Value" Then
strColNames(intColCounter) = "/PD_Current_Value/PD_Current_Value-" & (intRowCounter - 1)
ElseIf strColNames(intColCounter) = "/TE_BI_Current_Value" Then
strColNames(intColCounter) = "/TE_BI_Current_Value/TE_BI_Current_Value-" & (intRowCounter - 1)
ElseIf strColNames(intColCounter) = "/PD_Deductible" Then
strColNames(intColCounter) = "/PD_Deductible/PD_Deductible-" & (intRowCounter - 1)
ElseIf strColNames(intColCounter) = "/BI_TE_Ded" Then
strColNames(intColCounter) = "/BI_TE_Ded/BI_TE_Ded-" & (intRowCounter - 1)
ElseIf strColNames(intColCounter) = "/Adjusted_Loss_PD" Then
strColNames(intColCounter) = "/Adjusted_Loss_PD/Adjusted_Loss_PD-" & (intRowCounter - 1)
ElseIf strColNames(intColCounter) = "/Adjusted_Loss_TE_BI" Then
strColNames(intColCounter) = "/Adjusted_Loss_TE_BI/Adjusted_Loss_TE_BI-" & (intRowCounter - 1)
ElseIf strColNames(intColCounter) = "/Loss_Expectancy" Then
strColNames(intColCounter) = "/Loss_Expectancy/Loss_Expectancy-" & (intRowCounter - 1)
End If
ElseIf rNode(1) = "Type_of_Policy_Coverage" Then
If strColNames(intColCounter) = "/Description" Then
strColNames(intColCounter) = "/Description/Description-" & (intRowCounter - 1)
ElseIf strColNames(intColCounter) = "/Percentage" Then
strColNames(intColCounter) = "/Percentage/Percentage-" & (intRowCounter - 1)
End If
End If

If Left(strColNames(intColCounter), 1) = NODE_DELIMITER Then

Nodes = Split(strColNames(intColCounter), NODE_DELIMITER)
' check whether we are starting a new node or not
Dim i As Integer

Dim MatchAll As Boolean
MatchAll = True


For i = 1 To UBound(Nodes)

If i <= UBound(NodeStack) Then

If Trim(Nodes(i)) <> Trim(NodeStack(i)) Then
'not match
'MsgBox (Nodes(i) & "," & NodeStack(i))
MatchAll = False
Exit For

End If
Else
MatchAll = False
Exit For
End If



Next

' add close tags to those not used afterwards


' don't count it when no content
' If Trim(rngCell.Text) <> "" Then

If MatchAll Then
strXML = strXML & "</" & NodeStack(UBound(NodeStack)) & ">" & vbCrLf
Else
For t = UBound(NodeStack) To i Step -1
strXML = strXML & "</" & NodeStack(t) & ">" & vbCrLf
Next
End If

If i < UBound(Nodes) Then
For t = i To UBound(Nodes)
' add to the xml
strXML = strXML & "<" & Nodes(t) & ">"
If t = UBound(Nodes) Then

strXML = strXML & Trim(rngCell.Text)

End If

Next
Else
t = UBound(Nodes)
' add to the xml
strXML = strXML & "<" & Nodes(t) & ">"
strXML = strXML & Trim(rngCell.Text)

End If

NodeStack = Nodes

' Else
'
' ' since its a blank field, so no need to handle if field name repeated
' If Not MatchAll Then
' For t = UBound(NodeStack) To i Step -1
' strXML = strXML & "</" & Trim(NodeStack(t)) & ">" & vbCrLf
' Next
' End If
'
' ReDim Preserve NodeStack(i - 1)
' End If


' the last column
If intRowCounter = intRowCount Then
' add close tags to those not used afterwards
If UBound(NodeStack) <> 0 Then
For t = UBound(NodeStack) To 1 Step -1

strXML = strXML & "</" & Trim(NodeStack(t)) & ">" & vbCrLf

Next
End If
End If

Else
' add close tags to those not used afterwards
If UBound(NodeStack) <> 0 Then
For t = UBound(NodeStack) To 1 Step -1

strXML = strXML & "</" & Trim(NodeStack(t)) & ">" & vbCrLf

Next
End If
ReDim NodeStack(0)

' skip if no content
If Trim(rngCell.Text) <> "" Then
strXML = strXML & "<" & Trim(strColNames(intColCounter)) & ">" & Trim(rngCell.Text) & "</" & Trim(strColNames(intColCounter)) & ">" & vbCrLf
End If

End If


If rNode(1) = "Actual_Loss_History" Or rNode(1) = "As_If_Loss_History" Then
If intColCounter = 1 Then
strColNames(intColCounter) = "/Policy_Years"
ElseIf intColCounter = 2 Then
strColNames(intColCounter) = "/Loss_Descriptions"
ElseIf intColCounter = 3 Then
strColNames(intColCounter) = "/Date_of_Loss"
ElseIf intColCounter = 4 Then
strColNames(intColCounter) = "/PD_Gross_Loss"
ElseIf intColCounter = 5 Then
strColNames(intColCounter) = "/TE_BI_Gross_Loss"
ElseIf intColCounter = 6 Then
strColNames(intColCounter) = "/PD_Current_Value"
ElseIf intColCounter = 7 Then
strColNames(intColCounter) = "/TE_BI_Current_Value"
ElseIf intColCounter = 8 Then
strColNames(intColCounter) = "/PD_Deductible"
ElseIf intColCounter = 9 Then
strColNames(intColCounter) = "/BI_TE_Ded"
ElseIf intColCounter = 10 Then
strColNames(intColCounter) = "/Adjusted_Loss_PD"
ElseIf intColCounter = 11 Then
strColNames(intColCounter) = "/Adjusted_Loss_TE_BI"
ElseIf intColCounter = 12 Then
strColNames(intColCounter) = "/Loss_Expectancy"
End If
ElseIf rNode(1) = "Type_of_Policy_Coverage" Then
If intColCounter = 1 Then
strColNames(intColCounter) = "/Description"
ElseIf intColCounter = 2 Then
strColNames(intColCounter) = "/Percentage"
End If
End If

Next
Next
End With

strXML = strXML & TAG_END

' Return the HTML string...
fGenerateXML = strXML

End Function

For i = 1 To UBound(Nodes)
    If i <= UBound(NodeStack) Then
        If Trim(Nodes(i)) <> Trim(NodeStack(i)) Then
            'not match
            'MsgBox (Nodes(i) & "," & NodeStack(i))
            MatchAll = False
            Exit For
        End If
    Else
        MatchAll = False
        Exit For
    End If
Next

Function getNodeAttributes(node As String) As String
Dim str_att As String
If node = "Policy_Years" Then
   str_att = "Attribute=" & "1,1,0,1,16711680,2,0,0,1,16711680,0,0,0,0,0,0.5,10,Arial,1"" Attribute2="""
End If
End Function

strXML = strXML & "<" & Nodes(t) & getNodeAttributes(Nodes(t)) & ">"

priyaahh wrote:

strXML = strXML & "<" & Nodes(t) & getNodeAttributes(Nodes(t)) & ">"

priyaahh wrote:

str_att = "Attribute=" & "1,1,0,1,16711680,2,0,0,1,16711680,0,0,0,0,0,0.5,10,Arial,1"" Attribute2="""

Function getNodeAttributes(node As String) As String

'Do whatever you need

'Return the output to the caller
getNodeAttributes = str_att

End Function