Visual Basic Discussion Boards

E.F. Nijboer19-Jul-10 4:47

19-Jul-10 4:47

You would need a reference to the microsoft tabbed dialog control (TabCtl32.ocx). Right click components -> "Components..." and add it in the Component dialog.

Good luck!

PURPOSE: Delays program execution until designated condition is indicated.

Re: adding tab control in VB6

Sakhalean19-Jul-10 18:55

Sakhalean

19-Jul-10 18:55

OK I know that but how to use it.

I want to add two forms to the tab control.

how to do this?

Can you give me help?

Re: adding tab control in VB6

Neville Nazerane20-Jul-10 1:48

Neville Nazerane

20-Jul-10 1:48

if u want to add controls in the tabs you very well can. But can you please elabrate on the point about adding 'two forms'. i am sure i can help you with this if u could tell me that.

do you mean that u have 2 forms and want it added it in a tab?

Re: adding tab control in VB6

E.F. Nijboer20-Jul-10 6:00

E.F. Nijboer

20-Jul-10 6:00

Maybe this could work:

Dim frm As new Form1
frm.TopLevel = False
frm.Parent = tabMain.TabPages(0)
frm.FormBorderStyle = bsNone
frm.Show()

Good luck!

PURPOSE: Delays program execution until designated condition is indicated.

Re: adding tab control in VB6

Goutam Patra19-Jul-10 22:42

Goutam Patra

19-Jul-10 22:42

You cannot add a form inside a Tab control

Re: adding tab control in VB6

MikeD 227-Jul-10 3:38

MikeD 2

27-Jul-10 3:38

it sounds to me like you should be adding two frames, build all your controls on to the correct frames and then make one frame visible and the other invisible invisible when the user clicks on the relevant tab

How to pass in class to web service?

Steve van Niman18-Jul-10 5:06

Steve van Niman

18-Jul-10 5:06

Hopefully can give enough information to get pointed in the right direction.

Wrote a fairly extensive class and placed in .dll for use in a client application AND my web service. I declare the class as a one dimensional array and then try to pass into the web service; however, when I set client.class = ws.class I get a compilation error indicating that ws.class cannot be converted to client.class.

I've tried CType and DirectCast, but both complain of the same thing. Do I need to write a conversion routine in my code to parse each node of the class? There must be an easier way....

<br />
<br />
(.dll)<br />
<br />
<br />
public class Address<br />
private _x as string<br />
private _y as string<br />
get/set for x and y<br />
<br />
public sub New()<br />
_x=""<br />
_y=""<br />
end sub<br />
end class<br />
<br />
<br />
(client)<br />
<br />
dim a() as Address<br />
... read data and populate a()<br />
<br />
dim ws as new webservice.service<br />
ws.validate(a())<br />
<br />
<br />
(web service)<br />
<br />
public sub validate(byval b() as Address)<br />
<br />
<br />
<br />
When I try to run this I get a cannot convert client.a() to webservice.b() even though they implement the .dll with the same class.<br />
<br />
I don't understand what serialization does for an array, so I'm off to study how that will effect these calls.  In the mean time, if someone could point me in the proper directly, it would be greatly appreciated.<br />
<br />
<br />
<br />
<br />
<br />

Re: How to pass in class to web service?

nlarson1118-Jul-10 6:13

nlarson11

18-Jul-10 6:13

One way to accomplish this is to put the class in a dll that both sides (client/server) reference.

'Never argue with an idiot; they'll drag you down to their level and beat you with experience.' ~ anonymous

'Life's real failure is when you do not realize how close you were to success when you gave up.' ~ anonymous

Re: How to pass in class to web service?

Steve van Niman18-Jul-10 6:16

Steve van Niman

18-Jul-10 6:16

I did, both client and web service use the dll. That is what has me perplexed. The message will read module1.class cannot be converted to module2.class.

Re: How to pass in class to web service?

nlarson1118-Jul-10 6:42

nlarson11

18-Jul-10 6:42

If you using the same dll, then why is it saying different names for the class? class1 in the client is the same as class 1 in the service.

so just to clarify

you have a dll called "mysharedclasses" you webservice has a copy that it references. your client has a copy for it to reference. correct so far?

Re: How to pass in class to web service?

Steve van Niman18-Jul-10 7:01

Steve van Niman

18-Jul-10 7:01

correct. This is the exact message:

Value of type '1-dimensional array of PNDataMap.AddressStructure' cannot be converted to '1-dimensional array of CardProgramNG.ValidateService.AddressStructure' because 'PNDataMap.AddressStructure' is not derived from 'CardProgramNG.ValidateService.AddressStructure'.

Re: How to pass in class to web service?

Luc Pattyn18-Jul-10 7:28

Luc Pattyn

18-Jul-10 7:28

Of course PNDataMap.AddressStructure and CardProgramNG.ValidateService.AddressStructure are different types, even their namespaces are different. If they were the same type, the whole namespace mechanism wouldn't make any sense at all.

Smile | :)

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.

Re: How to pass in class to web service?

Steve van Niman18-Jul-10 8:09

Steve van Niman

18-Jul-10 8:09

which begs the question, how do I pass a class through to a web service?

Re: How to pass in class to web service?

Luc Pattyn18-Jul-10 8:16

Luc Pattyn

18-Jul-10 8:16

how do you serialize, and later deserialize some object? by using the same type, i.e. the same assembly, for both operations, whether they are executed by one or more processes. A web service doesn't change that. If one party has set the type, the other party has to agree on using the same type.

Smile | :)

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.

Re: How to pass in class to web service?

Steve van Niman18-Jul-10 8:41

Steve van Niman

18-Jul-10 8:41

Good question - how do you serialize the object? As stated in the opening question, I have never had to serialize anything - meaning no experience.

Re: How to pass in class to web service?

Luc Pattyn18-Jul-10 8:46

Luc Pattyn

18-Jul-10 8:46

Then start by studying the subject. Read the relevant chapter in your C#/VB.NET book, then go and look for some of those excellent CodeProject articles, and finally apply what you have learned. You're probably too old for spoon feeding anyway.

Smile | :)

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.

Adding Attributes to XML node using VBA

priyaahh17-Jul-10 7:12

priyaahh

17-Jul-10 7:12

Hi Friends,

I am creating an xml file with excel vba. Now I wanted to add attributes to the xml child nodes..Please kindly help..

Thanks in advance

Regards,
Priya.

Re: Adding Attributes to XML node using VBA

DaveAuld17-Jul-10 10:08

DaveAuld

17-Jul-10 10:08

One option would be to use MS XML Core Services COM.

Add a reference to the MS XML V6 library from the Tools Reference menu in the VBA editor.

You can then refere to the MSDN documentation on how to use this with VB.
http://msdn.microsoft.com/en-us/library/ms763742(v=VS.85).aspx[^]

The example below will load an XML file from hdd.

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

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

priyaahh17-Jul-10 11:37

priyaahh

17-Jul-10 11:37

Hi
Thanks. WIthout using XNL COM, I tried the following by directly giving in the tag line itself.

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

The above line I am spliting with /, then the first tag will be

<policy_years attr....="">
<policy_years-1>10

But when i give attribute like above I am getting error:

A name contained an invalid character. Error processing resource 'file:///D:/PIMSlite/Output/PolicyLocation.xml'. Line 15,...

</Policy_Years Attribute="1,1,0,1,16711680,2,0,0,1,16711680,0,0,0,0,0,0.5,10,Arial,1" Attribute2="">
---------------^

Is any error in the line where I have specified Attribute..

Thanks again.

Regards,
Priya.

Re: Adding Attributes to XML node using VBA

DaveAuld18-Jul-10 1:43

DaveAuld

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.

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