Re: Adding Attributes to XML node using VBA - Visual Basic Discussion Boards

Re: Adding Attributes to XML node using VBA

DaveAuld18-Jul-10 1:43

18-Jul-10 1:43

You don't put attributes in the closing tags, you put them in the opening tag;

<tag attribute="some value">tag value</tag>

also, if you look at the first line you have 2 double quotes which is not valid.

Dave

Don't forget to rate messages! Find Me On: <a href="http://www.dave-auld.net/" target="_blank">Web</a>|<a href="http://www.facebook.com/dave.m.auld/" target="_blank">Facebook</a>|<a href="http://www.twitter.com/daveauld/" target="_blank">Twitter</a>|<a href="http://www.linkedin.com/in/daveauld" target="_blank">LinkedIn</a> Waving? dave.m.auld[at]googlewave.com

Re: Adding Attributes to XML node using VBA

priyaahh18-Jul-10 7:39

priyaahh

18-Jul-10 7:39

Hi,

Thanks for your reply.

Actually I am keeping attribute only in opening tag and also i am keeping "" since in the code it is expecting.

If i simply give <tag attribute="">value

it is giving error.It is not accepting from code.

Please help.

Regards,
Priya.

Re: Adding Attributes to XML node using VBA

DaveAuld18-Jul-10 7:44

DaveAuld

18-Jul-10 7:44

would really need to see some code, not alot else to go on.

Can you post code?

Dave

Don't forget to rate messages! Find Me On: <a href="http://www.dave-auld.net/" target="_blank">Web</a>|<a href="http://www.facebook.com/dave.m.auld/" target="_blank">Facebook</a>|<a href="http://www.twitter.com/daveauld/" target="_blank">Twitter</a>|<a href="http://www.linkedin.com/in/daveauld" target="_blank">LinkedIn</a> Waving? dave.m.auld[at]googlewave.com

Re: Adding Attributes to XML node using VBA

priyaahh18-Jul-10 8:51

priyaahh

18-Jul-10 8:51

Hi Dave,

Thanks again!.. Here is the code i am using for conversion.

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

I need to add attributes to the tags highlighted in bold and some more also..i just highlighted less...

Thanks lot.

Regards,
Priya.

Re: Adding Attributes to XML node using VBA

DaveAuld18-Jul-10 9:51

DaveAuld

18-Jul-10 9:51

1) can you edit your message and put the code in a code block with an attribute lang="vb", so it formats something more readable!

2) Do not user On Error Resume Next, how else will you trap problems

Change to On Error Goto ERROR_HANDLER, then at the end of the function put;

<PRE lang="vb">
' Return the HTML string...
fGenerateXML = strXML
Exit Function

ERROR_HANDLER:

MSGBOX "Error: " & Err.description

End Function
</pre>

3) You are doing far too much in the single function, split it up into smaller helper functions, one to create nodes, one to add attributes etc. It will be easier to program and follow.

Dave

Don't forget to rate messages! Find Me On: <a href="http://www.dave-auld.net/" target="_blank">Web</a>|<a href="http://www.facebook.com/dave.m.auld/" target="_blank">Facebook</a>|<a href="http://www.twitter.com/daveauld/" target="_blank">Twitter</a>|<a href="http://www.linkedin.com/in/daveauld" target="_blank">LinkedIn</a> Waving? dave.m.auld[at]googlewave.com

Re: Adding Attributes to XML node using VBA

priyaahh18-Jul-10 10:07

priyaahh

18-Jul-10 10:07

Hi Dave,

Ya sure I will split this function.

I wanted to add attribute which i have posted in my first post to the tags highlighted in bold.

Appreaciate u lot..pls help..its urgent..

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

I need to add attributes to the tags highlighted in bold and some more also..i just highlighted less...

Thanks lot.

Regards,
Priya.

Re: Adding Attributes to XML node using VBA

DaveAuld18-Jul-10 10:51

DaveAuld

18-Jul-10 10:51

You have some wierdness going on around your arrays, either i am missing something or your code is wrong, here are all the NodeStack references;

Line 141: Dim NodeStack() as String

Line 168: ReDim NodeStack(0)

Line 229:

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

Up until this point NodeStack does not contain any values, it is a completly empty array, but yet you are trying to compare values etc from it.

It is not until later in your code that you give it any values by NodeStack = Nodes, and that is only if Nodes does actually contain values.
I suspect your code is throwing exceptions, but because you current On Error Resume Next you are not seeing them.

Dave

Don't forget to rate messages!
Find Me On: Web|Facebook|Twitter|LinkedIn
Waving? dave.m.auld[at]googlewave.com

Re: Adding Attributes to XML node using VBA

priyaahh18-Jul-10 10:59

priyaahh

18-Jul-10 10:59

Hi,

Code is working fine. I tried by removing on error resume next. Problem is that if i add attribute to that tags which is like Attribute="1,1,1,..."
then it is giving error.

I am not sure the way to keep the attributes there.

Or is there any way after generation of an xml, can we open that xml file and add attributes to that?

Regards,
Priya.

Re: Adding Attributes to XML node using VBA

DaveAuld18-Jul-10 11:08

DaveAuld

18-Jul-10 11:08

I had a think about what i had written, and no it won't throw an excpetion, All that will happen is MatchAll will always be False so that code is effectively doing nothing (because 1 or higher is always greater than 0).

All you are doing is generating a bunch of strings and bolting them altogether.

After you generate the xml and the function exits, have you had a look at the XML file to see what it looks like?

Dave

Don't forget to rate messages!
Find Me On: Web|Facebook|Twitter|LinkedIn
Waving? dave.m.auld[at]googlewave.com

Re: Adding Attributes to XML node using VBA

priyaahh18-Jul-10 11:47

priyaahh

18-Jul-10 11:47

Hi Dave,

Thanks. Yes XML looks good.

Regards,
Priya.

Re: Adding Attributes to XML node using VBA

DaveAuld18-Jul-10 12:10

DaveAuld

18-Jul-10 12:10

In that case all you are doing now then is adding the attributes to the node.

Create a helper function like; getNodeAttributes(node as integer) as string

In it, test node to see which attributes you need to build, then return them in the function, if the node does not need any attributes, then return an empty string.

Then modify;
strXML = strXML & "<" & Nodes(t) & ">"

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

simples........

Dave

Don't forget to rate messages!
Find Me On: Web|Facebook|Twitter|LinkedIn
Waving? dave.m.auld[at]googlewave.com

Re: Adding Attributes to XML node using VBA

priyaahh18-Jul-10 13:38

priyaahh

18-Jul-10 13:38

Hi Dave,

Thanks lot.

I tried adding the funtion like :

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

and also changed

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

Just tried assigning attribute to only one node. But I am not getting any in the output for the tag Policy_Years.

Please Help..

Regards,
Priya.

Re: Adding Attributes to XML node using VBA

DaveAuld18-Jul-10 14:00

DaveAuld

18-Jul-10 14:00

Of course you wont, your passing across the node index not the node name;

priyaahh wrote:
strXML = strXML & "<" & Nodes(t) & getNodeAttributes(Nodes(t)) & ">"

change to;

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

Dave

Don't forget to rate messages!
Find Me On: Web|Facebook|Twitter|LinkedIn
Waving? dave.m.auld[at]googlewave.com

Re: Adding Attributes to XML node using VBA

priyaahh18-Jul-10 19:44

priyaahh

18-Jul-10 19:44

Hi Dave,

Still no its not showing... Frown | :-(

Is there any other way to implement this?

Regards,
Priya.

Re: Adding Attributes to XML node using VBA

DaveAuld18-Jul-10 22:23

DaveAuld

18-Jul-10 22:23

Well i fail to see what you are doing wrong. Don't give in!

At the end of the day, all you are doing is simple string manipulation, it doesn't matter if it is in XML format or any other text based format.

If your output XML file shows the attributes after your text generation then it is working.

If your output does not show the attributes, then your code is wrong.

You maybe need to start putting in extra breakpoints, debug.print(), or message boxes statements through your code until you can find out what is going on. everytime you generate a node or an attribute use these statements to see what the string is before and after. That way you will be able to see what you are getting versus what you are expecting at each stage. This is basic troubleshooting. As i have stated before your function is way to big, and you really need to restructure and break out lots of smaller helper functions which can then be called to piece the final text XML string.

As i say, this is basic string manipulation, so something obvious is wrong somewhere!

Dave

Don't forget to rate messages!
Find Me On: Web|Facebook|Twitter|LinkedIn
Waving? dave.m.auld[at]googlewave.com

Re: Adding Attributes to XML node using VBA

priyaahh18-Jul-10 22:59

priyaahh

18-Jul-10 22:59

Hi Dave,

Thanks really!...

I am planning another way. TO open the xml file generated and then adding attributes to elements.

If you dont mind can you please give me example for this. Yes i remember, you have sent me the reference to DOM Methods for implementing this. But at this point of time with so much stress i cannt think of anything and this have to completed asap i do not have even hours of time...pls pls help..

Thanks in advance..reply if ur online

Regards,
Priya

Re: Adding Attributes to XML node using VBA

DaveAuld18-Jul-10 23:17

DaveAuld

18-Jul-10 23:17

No that is not the way to go, you are making things harder for your self, you will then have to read, parse, inject , save strings.

You have already got a function that generates a valid XML file, so you are 99% of the way there.

Have you done what i have suggested with regards to breakpoints and or debug statements?

strategically place them in your code, and you will see where the attributes you have added are then disappearing (if they are disappearing at all that is).

Also, in the previous message did you replace both instances of the code where you inject the attribute function? you have 2 lines that do it depending on the state of some value. Did you please a debug statement in your attribute function to prove it is being called? Did you add a debug.print statement to see what it was adding to the string?

Dave

Don't forget to rate messages!
Find Me On: Web|Facebook|Twitter|LinkedIn
Waving? dave.m.auld[at]googlewave.com

Re: Adding Attributes to XML node using VBA

priyaahh18-Jul-10 23:32

priyaahh

18-Jul-10 23:32

Dave,
<pre attribute="vb">
Yes I did debut and breakpoints.

Actually I have to keep getNodeAttribute function in the first set not in the second set. I examined that.

During call of the above function i print the var in immediate window. it is printing like :

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

but when it go back to the main line from where are calling the function it is not returning anything..

Hope u might got my explanation..pls help

This is my function:

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="""

ElseIf node = "Loss_Descriptions" 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="""
Debug.Print str_att

End If
End Function

Calling the above function from the below line:

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

I wanted output like:

<Adjusted_Loss_PD Attribute="1,1,0,1,16711680,2,0,0,1,16711680,0,0,0,0,0,0.5,10,Arial,1" Attribute2="">
<Adjusted_Loss_PD-1 />
<Adjusted_Loss_PD-2 />
<Adjusted_Loss_PD-3 />
<Adjusted_Loss_PD-4 />
<Adjusted_Loss_PD-5 />
<Adjusted_Loss_PD-6 />
<Adjusted_Loss_PD-7 />
<Adjusted_Loss_PD-8 />
<Adjusted_Loss_PD-9 />
<Adjusted_Loss_PD-10 />
</Adjusted_Loss_PD>

</pre>

Re: Adding Attributes to XML node using VBA

DaveAuld18-Jul-10 23:48

DaveAuld

18-Jul-10 23:48

It looks like you are missing quotes from the output string.

As you already know, you have to increase the number of quotes if you want to add quotes to the output, you are only doing this in some of your code.

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="""

Look at the code after "Attribute=" the opening value only has a single double quote, which will result in Attribute=1,1,....etc. and not Attribute="1,1,...etc.

yet at the end you correctly add the extra quotes. you can always consider user Char(34) in you string generator so you can see where you want to add the quote to the output e.g. (34 is the ASCII value for a double quote, look at asciitable[^])

str_Att = "Attribute1=" & chr(34) & "1,1,0,1,16711680,2,0,0,1,16711680,0,0,0,0,0,0.5,10,Arial,1" & chr(34) & " Attribute2=" & chr(34) & "some value" & chr(34)

Dave

Don't forget to rate messages!
Find Me On: Web|Facebook|Twitter|LinkedIn
Waving? dave.m.auld[at]googlewave.com

Re: Adding Attributes to XML node using VBA

priyaahh18-Jul-10 23:59

priyaahh

18-Jul-10 23:59

Hi Dave,

Yes I have noticed that and changed...but why the function is not returning anything.

Regards,
Priya.

Re: Adding Attributes to XML node using VBA

DaveAuld19-Jul-10 0:02

DaveAuld

19-Jul-10 0:02

Because you haven't returned a value yet!

remember you need to set the function name to the value you want to return;

Function getNodeAttributes(node As String) As String

'Do whatever you need

'Return the output to the caller
getNodeAttributes = str_att

End Function

Dave

Don't forget to rate messages!
Find Me On: Web|Facebook|Twitter|LinkedIn
Waving? dave.m.auld[at]googlewave.com

Re: Adding Attributes to XML node using VBA

priyaahh21-Jul-10 1:26

priyaahh

21-Jul-10 1:26

Hi Dave,

Thank you so much for ur kind and immediate reply...it worked. Smile | :)

Regards,
Priya.

Message Removed

16-Jul-10 16:56

June 19, 2010

16-Jul-10 16:56

Message Removed

Re: Code for Enrollment System

Richard MacCutchan16-Jul-10 23:11

Richard MacCutchan

16-Jul-10 23:11

Nobody here is going to do your work so that you can be awarded a degree. Try searching the internet for a sample, but remember your professor will find the same results that you do. I expect he is reading your question right now.

It's time for a new signature.

Re: Code for Enrollment System [modified]

Luc Pattyn16-Jul-10 23:29

Luc Pattyn

16-Jul-10 23:29

rubyjera wrote:
hi everyone.,
can u pls help me with my thesis the Online Student System with Enrollment System..
Im new in Visual Basic 6.0. I will use it to make the Enrollment System..
Can u give me a sample code for Enrollment System..
this is my email add. tejado_rubymadelene05@yahooo.com
Hope U can help me
Thanx

How about I send you a master's degree in computer science right away. That would be easier for everyone.

Frown | :(

Luc Pattyn [Forum Guidelines] [Why QA sucks] [My Articles] Nil Volentibus Arduum

Please use <PRE> tags for code snippets, they preserve indentation, and improve readability.

modified on Saturday, July 17, 2010 9:01 AM

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.