- Exchanging Documents with VB and XML
- Outsourcing Data Entry
- Parsing XML
- Dig a Little Deeper
Dig a Little Deeper
As documented on MSDN, the code generator contains some limitations in terms of the schema and the functionality that it supports (keep in mind that in addition to the code generator discussed here, the BizTalk JumpStart Kit includes a code generator that yields similar results but that has different limitations). However, if you're willing to get your hands a little bit dirty with MSXML, you can modify the generated code to fit your own needs. For example, in this project we added Hydrate and SaveXML methods to the CXML_Document class; in so doing, the component could load its object model based on an array structure that is used in an existing application, and could then write out the contents of the object model to an XML file, respectively.
The SaveXML method, which can be seen in Listing 2, uses the DOMDocument, IXMLDOMElement, and IXMLDomNode objects exposed by MSXML to create new elements from private data that is encapsulated in the CXML_Document object, and then add them to the Document element before appending it to the XML file. With the basic model, you can create elements using the createElement method of the DOMDocument object (which represents the entire XML file) and then use the setAttribute method of the returned IXMLDOMElement object to create its attributes. You can then add the new element to an existing element using the appendChild method. The following simplified code snippet shows how the Name element of the XML document is created using MSXML.
Dim xmlDoc As DOMDocument Dim newDoc As IXMLDOMElement Dim xmlElem As IXMLDOMElement Dim root As IXMLDOMNode ' Load and create xmlDoc … ' Set the root to CirculationData Set root = xmlDoc.documentElement ' Create a new Document element Set newDoc = xmlDoc.createElement("Document") ' … add other elements here ' Create the new Name element Set xmlElem = xmlDoc.createElement("Name") ' Add its attributes With xmlElem .setAttribute "FName", m_obj_Name.FName .setAttribute "LName", m_obj_Name.LName .setAttribute "SubscriberTitle", m_obj_Name.SubscriberTitle .setAttribute "CompanyName", m_obj_Name.CompanyName .setAttribute "NameChange", m_obj_Name.NameChange .setAttribute "NameAdd", m_obj_Name.NameAdd .setAttribute "Dept", m_obj_Name.Dept End With ' Append the Name element under the Document element newDoc.appendChild xmlElem ' Append the Document element under the root root.appendChild newDoc ' Write out the file xmlDoc.save pXMLFile
Notice that the m_obj_Name private variable refers to a CXML_Name object that is generated by the code generator and holds the representation for data in the Name element. Listing 3 shows a part of the XML document that is produced by the SaveXML method.
By using the combination of an NT service and a component model, it is relatively simple to create a process that parses XML documents and extracts their contents for loading in a database. So why don't you get started putting XML to work?
Figure 1 The application architecture. Via FTP, documents are transferred to a central server by the data entry vendor; there they are processed by an NT service that parses them and loads their contents into a SQL database via COM components that run in MTS.
Listing 1 The XML-Data Schema for the Data Collection Company
<?xml version ="1.0"?> <Schema name="ACME DataCollection" xmlns="urn:schemas-microsoft-com:xml-data" xmlns:dt="urn:schemas-microsoft-com:datatypes"> <AttributeType name = "PublicationID" dt:type = "int" required = "yes"/> <AttributeType name = "DataSourceCode" dt:type = "string" required = "yes"/> <AttributeType name = "PromoCodeScan" dt:type = "string" required = "yes"/> <AttributeType name = "SubscriberID" dt:type = "string"/> <AttributeType name = "Receive" dt:type = "enumeration" dt:values = "Y N NULL" required = "yes"/> <AttributeType name = "AddressChange" dt:type = "enumeration" dt:values = "Y N" default = "N"/> <AttributeType name = "Signature" dt:type = "enumeration" dt:values = "Y N" default = "N"/> <AttributeType name = "SignatureMatch" dt:type = "enumeration" dt:values = "Y N" default = "N"/> <AttributeType name = "ScanDate" dt:type = "dateTime" required = "yes"/> <AttributeType name = "FName" dt:type = "string"/> <AttributeType name = "LName" dt:type = "string"/> <AttributeType name = "SubscriberTitle" dt:type = "string"/> <AttributeType name = "CompanyName" dt:type = "string"/> <AttributeType name = "NameChange" dt:type = "enumeration" dt:values = "Y N" default = "N"/> <AttributeType name = "NameAdd" dt:type = "enumeration" dt:values = "Y N" default = "N"/> <AttributeType name = "Dept" dt:type = "string"/> <AttributeType name = "KillCode" dt:type = "enumeration" dt:values = "K D P R" required = "yes"/> <AttributeType name = "ImmediateNeed" dt:type = "enumeration" dt:values = "Y N" default = "N"/> <AttributeType name = "Sequence" dt:type = "int" required = "yes"/> <AttributeType name = "QuestionCode" dt:type = "string" required = "yes"/> <AttributeType name = "AnswerCode" dt:type = "string" required = "yes"/> <AttributeType name = "FirstName" dt:type = "string" required = "yes"/> <AttributeType name = "LastName" dt:type = "string" required = "yes"/> <AttributeType name = "Address" dt:type = "string"/> <AttributeType name = "Address2" dt:type = "string"/> <AttributeType name = "MailStop" dt:type = "string"/> <AttributeType name = "Country" dt:type = "string" default = "USA"/> <AttributeType name = "City" dt:type = "string"/> <AttributeType name = "StateProvince" dt:type = "string"/> <AttributeType name = "FDPostalCode" dt:type = "string"/> <AttributeType name = "AddressType" dt:type = "enumeration" dt:values = "H B" default = "B"/> <AttributeType name = "TextResponse" dt:type = "string"/> <AttributeType name = "DocumentID" dt:type = "string" required = "yes"/> <AttributeType name = "VendorID" dt:type = "int" required = "yes"/> <AttributeType name = "PromoCode" dt:type = "string"/> <AttributeType name = "ElapsedTime" dt:type = "number" required = "yes"/> <AttributeType name = "OperatorID" dt:type = "string" required = "yes"/> <AttributeType name = "Specialist" dt:type = "enumeration" dt:values = "Y N" default = "N"/> <AttributeType name = "SpecialistMessage" dt:type = "string"/> <AttributeType name = "Rescan" dt:type = "enumeration" dt:values = "Y N" default = "N"/> <AttributeType name = "Extension" dt:type = "string"/> <ElementType name = "DocIndex" content = "empty" model = "closed"> <attribute type = "PublicationID"/> <attribute type = "DataSourceCode"/> <attribute type = "PromoCodeScan"/> <attribute type = "ScanDate"/> </ElementType> <ElementType name = "Subscriber" content = "empty" model = "closed"> <attribute type = "SubscriberID"/> <attribute type = "Receive"/> <attribute type = "AddressChange"/> <attribute type = "Signature"/> <attribute type = "SignatureMatch"/> </ElementType> <ElementType name = "Name" content = "empty" model = "closed"> <attribute type = "FName"/> <attribute type = "LName"/> <attribute type = "SubscriberTitle"/> <attribute type = "CompanyName"/> <attribute type = "NameChange"/> <attribute type = "NameAdd"/> <attribute type = "Dept"/> </ElementType> <ElementType name = "KillSubscriber" content = "textOnly" model = "closed"> <attribute type = "KillCode"/> </ElementType> <ElementType name = "PhoneNo" content = "textOnly" model = "closed"> <attribute type = "Extension"/> </ElementType> <ElementType name = "FaxNo" content = "textOnly"/> <ElementType name = "Internet" content = "textOnly"/> <ElementType name = "Email" content = "textOnly"/> <ElementType name = "IssueDate" content = "textOnly"/> <ElementType name = "DocumentResponse" content = "empty" model = "closed"> <attribute type = "Sequence"/> <attribute type = "QuestionCode"/> <attribute type = "AnswerCode"/> <attribute type = "TextResponse"/> </ElementType> <ElementType name = "BingoResponse" content = "textOnly" model = "closed"> <attribute type = "ImmediateNeed"/> </ElementType> <ElementType name = "PassAlong" content = "empty" model = "closed"> <attribute type = "Sequence"/> <attribute type = "FirstName"/> <attribute type = "LastName"/> <attribute type = "SubscriberTitle"/> <attribute type = "CompanyName"/> <attribute type = "Address"/> <attribute type = "Address2"/> <attribute type = "Country"/> <attribute type = "City"/> <attribute type = "StateProvince"/> <attribute type = "FDPostalCode"/> </ElementType> <ElementType name = "DocumentAddress" content = "empty" model = "closed"> <attribute type = "Address" required = "yes"/> <attribute type = "Address2"/> <attribute type = "MailStop"/> <attribute type = "Country"/> <attribute type = "City"/> <attribute type = "StateProvince"/> <attribute type = "FDPostalCode"/> <attribute type = "AddressType"/> </ElementType> <ElementType name = "CirculationData" model = "closed" content = "eltOnly" order = "seq"> <element type = "Document" minOccurs = "1" maxOccurs = "*"/> </ElementType> <ElementType name = "Document" content = "eltOnly" order = "seq" model = "closed"> <attribute type = "DocumentID"/> <attribute type = "VendorID"/> <attribute type = "PromoCode"/> <attribute type = "ElapsedTime"/> <attribute type = "OperatorID"/> <attribute type = "Specialist"/> <attribute type = "SpecialistMessage"/> <attribute type = "Rescan"/> <element type = "DocIndex" minOccurs = "0" maxOccurs = "1"/> <element type = "Subscriber"/> <element type = "Name"/> <element type = "KillSubscriber" minOccurs = "0" maxOccurs = "*"/> <element type = "PhoneNo" minOccurs = "0" maxOccurs = "1"/> <element type = "FaxNo" minOccurs = "0" maxOccurs = "1"/> <element type = "Internet" minOccurs = "0" maxOccurs = "1"/> <element type = "Email" minOccurs = "0" maxOccurs = "1"/> <element type = "DocumentResponse" minOccurs = "0" maxOccurs = "*"/> <element type = "BingoResponse" minOccurs = "0" maxOccurs = "*"/> <element type = "DocumentAddress" minOccurs = "0" maxOccurs = "*"/> <element type = "PassAlong" minOccurs = "0" maxOccurs = "*"/> </ElementType> </Schema>
Listing 2 The Custom SaveXML Method Used to Extract Data from the Object Model and Save It to the Given File
Public Sub SaveXML(ByVal pXMLFile As String, ByVal pAppend As Boolean, _ ByVal pElapsedTime As Long) ' Check to see if a document has data. If it does, don't build it Static xmlDoc As DOMDocument Static strXMLFile As String Dim objFS As FileSystemObject Dim objText As TextStream Dim newDoc As IXMLDOMElement Dim xmlElem As IXMLDOMElement Dim root As IXMLDOMNode Dim i As Integer ' Write out the XML On Error GoTo SaveXMLErr Set objFS = New FileSystemObject If pAppend Then ' Raise an error if the file is not found If Not objFS.FileExists(pXMLFile) Then ' Create the file if it does not exist Set objText = objFS.OpenTextFile(pXMLFile, ForWriting, True) ' Put in the header objText.WriteLine "" objText.WriteLine "" objText.WriteLine " " objText.Close Set xmlDoc = Nothing strXMLFile = vbNullString End If Else ' Create the file if it does not exist Set objText = objFS.OpenTextFile(pXMLFile, ForWriting, True) ' Put in the header objText.WriteLine "" objText.WriteLine "" objText.WriteLine " " objText.Close Set xmlDoc = Nothing strXMLFile = vbNullString End If Set objText = Nothing Set objFS = Nothing ' Load the XML document If strXMLFile <> pXMLFile Then Set xmlDoc = New DOMDocument xmlDoc.async = False xmlDoc.Load pXMLFile End If strXMLFile = pXMLFile ' Set the root to CirculationData Set root = xmlDoc.documentElement '*************************************************** ' Create the new Document Set newDoc = xmlDoc.createElement("Document") ' Add its attributes With newDoc .setAttribute "DocumentID", m_str_DocumentID If m_lng_VendorID <> 0 Then .setAttribute "VendorID", m_lng_VendorID If m_str_PromoCode <> vbNullString Then .setAttribute "PromoCode", m_str_PromoCode .setAttribute "ElapsedTime", pElapsedTime .setAttribute "OperatorID", m_str_OperatorID .setAttribute "Specialist", m_str_Specialist .setAttribute "SpecialistMessage", m_str_SpecialistMessage .setAttribute "Rescan", m_str_Rescan End With '**************************************************** ' Add the DocIndex element If m_col_DocIndex.Count = 1 Then Set xmlElem = xmlDoc.createElement("DocIndex") ' Add its attributes With xmlElem If m_col_DocIndex(1).PublicationID <> 0 Then _ .setAttribute "PublicationID", m_col_DocIndex(1).PublicationID If m_col_DocIndex(1).DataSourceCode <> vbNullString Then _ .setAttribute "DataSourceCode", m_col_DocIndex(1).DataSourceCode If m_col_DocIndex(1).PromoCodeScan <> vbNullString Then _ .setAttribute "PromoCodeScan", m_col_DocIndex(1).PromoCodeScan If m_col_DocIndex(1).ScanDate <> 0 Then _ .setAttribute "ScanDate", m_col_DocIndex(1).ScanDate End With newDoc.appendChild xmlElem End If '**************************************************** ' Add the Subscriber element Set xmlElem = xmlDoc.createElement("Subscriber") ' Add its attributes With xmlElem If m_obj_Subscriber.SubscriberID <> vbNullString Then _ .setAttribute "SubscriberID", m_obj_Subscriber.SubscriberID .setAttribute "Receive", m_obj_Subscriber.Receive .setAttribute "AddressChange", m_obj_Subscriber.AddressChange .setAttribute "Signature", m_obj_Subscriber.Signature .setAttribute "SignatureMatch", m_obj_Subscriber.SignatureMatch End With newDoc.appendChild xmlElem '**************************************************** ' Add the Name element Set xmlElem = xmlDoc.createElement("Name") ' Add its attributes With xmlElem If m_obj_Name.FName <> vbNullString Then .setAttribute "FName", m_obj_Name.FName If m_obj_Name.LName <> vbNullString Then .setAttribute "LName", m_obj_Name.LName If m_obj_Name.SubscriberTitle <> vbNullString Then _ .setAttribute "SubscriberTitle", m_obj_Name.SubscriberTitle .setAttribute "CompanyName", m_obj_Name.CompanyName .setAttribute "NameChange", m_obj_Name.NameChange .setAttribute "NameAdd", m_obj_Name.NameAdd If m_obj_Name.Dept <> vbNullString Then .setAttribute "Dept", m_obj_Name.Dept End With newDoc.appendChild xmlElem '**************************************************** ' Add the KillSubscriber elements For i = 1 To m_col_KillSubscriber.Count Set xmlElem = xmlDoc.createElement("KillSubscriber") ' Add its attributes With xmlElem .Text = m_col_KillSubscriber(i).Value .setAttribute "KillCode", m_col_KillSubscriber(i).KillCode .setAttribute "FName", m_col_KillSubscriber(i).FName .setAttribute "LName", m_col_KillSubscriber(i).LName End With newDoc.appendChild xmlElem Next i '**************************************************** ' Add the PhoneNo element If m_col_PhoneNo.Count = 1 Then Set xmlElem = xmlDoc.createElement("PhoneNo") ' Add its attributes With xmlElem .Text = m_col_PhoneNo(1).Value .setAttribute "Extension", m_col_PhoneNo(1).Extension End With newDoc.appendChild xmlElem End If '**************************************************** ' Add the FaxNo element If m_col_FaxNo.Count = 1 Then Set xmlElem = xmlDoc.createElement("FaxNo") ' Add its attributes With xmlElem .Text = m_col_FaxNo(1) End With newDoc.appendChild xmlElem End If '**************************************************** ' Add the Internet element If m_col_Internet.Count = 1 Then Set xmlElem = xmlDoc.createElement("Internet") ' Add its attributes With xmlElem .Text = m_col_Internet(1) End With newDoc.appendChild xmlElem End If '**************************************************** ' Add the Email element If m_col_Email.Count = 1 Then Set xmlElem = xmlDoc.createElement("Email") ' Add its attributes With xmlElem .Text = m_col_Email(1) End With newDoc.appendChild xmlElem End If '**************************************************** ' Add the Issue Date element If m_col_IssueDate.Count = 1 Then Set xmlElem = xmlDoc.createElement("IssueDate") ' Add its attributes With xmlElem .Text = m_col_IssueDate(1) End With newDoc.appendChild xmlElem End If '**************************************************** ' Add the Document Response elements For i = 1 To m_col_DocumentResponse.Count Set xmlElem = xmlDoc.createElement("DocumentResponse") ' Add its attributes With xmlElem .setAttribute "Sequence", m_col_DocumentResponse(i).Sequence .setAttribute "QuestionCode", m_col_DocumentResponse(i).QuestionCode .setAttribute "AnswerCode", m_col_DocumentResponse(i).AnswerCode If m_col_DocumentResponse(i).TextResponse <> vbNullString Then _ .setAttribute "TextResponse", m_col_DocumentResponse(i).TextResponse End With newDoc.appendChild xmlElem Next i '**************************************************** ' Add the BingoResponse elements For i = 1 To m_col_BingoResponse.Count Set xmlElem = xmlDoc.createElement("BingoResponse") ' Add its attributes With xmlElem .Text = m_col_BingoResponse(i).Value .setAttribute "ImmediateNeed", m_col_BingoResponse(i).ImmediateNeed End With newDoc.appendChild xmlElem Next i '**************************************************** ' Add the DocumentAddress elements For i = 1 To m_col_DocumentAddress.Count Set xmlElem = xmlDoc.createElement("DocumentAddress") ' Add its attributes With xmlElem .setAttribute "Address", m_col_DocumentAddress(i).Address If m_col_DocumentAddress(i).Address2 <> vbNullString Then _ .setAttribute "Address2", m_col_DocumentAddress(i).Address2 If m_col_DocumentAddress(i).MailStop <> vbNullString Then _ .setAttribute "MailStop", m_col_DocumentAddress(i).MailStop If m_col_DocumentAddress(i).Country <> vbNullString Then _ .setAttribute "Country", m_col_DocumentAddress(i).Country If m_col_DocumentAddress(i).City <> vbNullString Then _ .setAttribute "City", m_col_DocumentAddress(i).City If m_col_DocumentAddress(i).StateProvince <> vbNullString Then _ .setAttribute "StateProvince", m_col_DocumentAddress(i).StateProvince If m_col_DocumentAddress(i).FDPostalCode <> vbNullString Then _ .setAttribute "FDPostalCode", m_col_DocumentAddress(i).FDPostalCode .setAttribute "AddressType", m_col_DocumentAddress(i).AddressType End With newDoc.appendChild xmlElem Next i '**************************************************** ' Add the PassAlong elements For i = 1 To m_col_PassAlong.Count Set xmlElem = xmlDoc.createElement("PassAlong") ' Add its attributes With xmlElem .setAttribute "Sequence", m_col_PassAlong(i).Sequence .setAttribute "FirstName", m_col_PassAlong(i).FirstName .setAttribute "LastName", m_col_PassAlong(i).LastName If m_col_PassAlong(i).SubscriberTitle <> vbNullString Then _ .setAttribute "SubscriberTitle", m_col_PassAlong(i).SubscriberTitle If m_col_PassAlong(i).CompanyName <> vbNullString Then _ .setAttribute "CompanyName", m_col_PassAlong(i).CompanyName If m_col_PassAlong(i).Address <> vbNullString Then _ .setAttribute "Address", m_col_PassAlong(i).Address If m_col_PassAlong(i).Address2 <> vbNullString Then _ .setAttribute "Address2", m_col_PassAlong(i).Address2 If m_col_PassAlong(i).Country <> vbNullString Then _ .setAttribute "Country", m_col_PassAlong(i).Country If m_col_PassAlong(i).City <> vbNullString Then _ .setAttribute "City", m_col_PassAlong(i).City If m_col_PassAlong(i).StateProvince <> vbNullString Then _ .setAttribute "StateProvince", m_col_PassAlong(i).StateProvince If m_col_PassAlong(i).FDPostalCode <> vbNullString Then _ .setAttribute "FDPostalCode", m_col_PassAlong(i).FDPostalCode End With newDoc.appendChild xmlElem Next i ' Append the document element root.appendChild newDoc ' Write out the file xmlDoc.save pXMLFile Exit Sub SaveXMLErr: Err.Raise vbObjectError + 5000, "SaveXML", _ "An error occurred during the save: " & Err.Description Set objFS = Nothing Set xmlDoc = Nothing strXMLFile = vbNullString Set objText = Nothing End Sub