Greetings everyone. I am transitioning from vb6 to visual basic 2008. One project I had done in the past was to generate xml files using ADODB. I know this is no longer supported so I am curious in visual basic 2008 how I can accomplish the same task. In particular creating the connection to the sql server, populating the xml elements with the values from my database, and creating the xml file. Here is my code from vb6. I am looking to achieve the same results using the xml namespace if at all possible.. any feedback would be greatly appreciated.
Option Explicit
Private m_Conn As ADODB.Connection
Private m_RS As ADODB.Recordset
Private m_ConnString As String
Private m_sqlText As String
Public Property Get sqlText() As String
sqlText = m_sqlText
End Property
Public Property Let sqlText(ByVal nVal As String)
m_sqlText = Trim$(nVal)
End Property
Public Property Get ConnString() As String
ConnString = m_ConnString
End Property
Public Property Let ConnString(ByVal nVal As String)
m_ConnString = Trim$(nVal)
End Property
Public Sub Init()
If m_ConnString <> Empty Then
' If Connection String property has been set then open the Connection '
Set m_Conn = New ADODB.Connection
m_Conn.Open m_ConnString
Else
MsgBox "Not a valid Connection String to the Database.", vbOKOnly + vbCritical, "Connection Error"
End If
End Sub
Public Sub OpenRS()
If m_sqlText <> "" Then
' If the SqlText property has been set open the recordset '
'Set m_RS = New ADODB.Recordset
m_RS.Open m_sqlText, m_Conn, adOpenForwardOnly, adLockReadOnly
End If
End Sub
Public Sub GenerateXMLFile(ByVal nSQLStr As String, ByVal nOrdStatSQL As String)
'On Error GoTo genERROR
Dim StrHTML As String
'Dim strHeader As String
Dim objSendMail As CDONTS.NewMail
Dim HTMLfile As File
Dim fso As Scripting.FileSystemObject
'Dim tso As Scripting.TextStream
Dim m_RS As New ADODB.Recordset
Dim m_RS2 As New ADODB.Recordset
Dim m_Conn2 As New ADODB.Connection
Dim errLocation As Integer
Dim y As Long
Dim tCustCode As String
Dim strHeader As String
Dim tmpHTML As String
Dim SqlText2 As String
Dim ShipDate As String
Dim ShipDay As String
Dim ShipMonth As String
Dim ShipYear As String
Dim EventDate As String
Dim EventDay As String
Dim EventMonth As String
Dim EventYear As String
Dim DocumentDate As String
Dim dunsnumber As String
'Counter to be used for buyerLineItem record in m_RS2 loop
Dim counter As Integer
'WriteLog "*************** Begin Log ***************"
'WriteLog "---------------------------------------"
'WriteLog " Opening Recordset to Build XML files"
'WriteLog "---------------------------------------"
'WriteLog " "
'WriteLog "Using SQL Statement : "
'WriteLog nSQLStr
'WriteLog "--------------------------"
m_RS.Open Trim$(nSQLStr), m_Conn, adOpenForwardOnly, adLockReadOnly
'y = 0
'errLocation = 1
'WriteLog "Setup of XML File - " & "Order Status " & m_RS!cust_code & ".xml"
While Not m_RS.EOF
'fromRole Info about the partner sending the Order Status
StrHTML = StrHTML & "<?xml version='1.0' encoding='ISO-8859-1'?>" & vbNewLine
'This checks the generated xml against the PurchaseOrderStatusNotification dtd
'StrHTML = StrHTML & "<!DOCTYPE Pip3A6PurchaseOrderStatusNotification SYSTEM '3A6_MS_V02_00_PurchaseOrderStatusNotification.dtd'>" & vbNewLine
StrHTML = StrHTML & "<Pip3A6PurchaseOrderStatusNotification>" & vbNewLine
StrHTML = StrHTML & "<fromRole>" & vbNewLine
StrHTML = StrHTML & "<PartnerRoleDescription>" & vbNewLine
StrHTML = StrHTML & "<GlobalPartnerRoleClassificationCode>Shipper</GlobalPartnerRoleClassificationCode>" & vbNewLine
StrHTML = StrHTML & "<PartnerDescription>" & vbNewLine
StrHTML = StrHTML & "<BusinessDescription>" & vbNewLine
dunsnumber = (m_RS!orig_part_no)
If Left(dunsnumber, 2) = "V7" Or Left(dunsnumber, 2) = "V8" Then
StrHTML = StrHTML & "<GlobalBusinessIdentifier>00-339-6256-0001</GlobalBusinessIdentifier>" & vbNewLine
ElseIf Left(dunsnumber, 1) = "F" Then
StrHTML = StrHTML & "<GlobalBusinessIdentifier>00-339-6256-0002</GlobalBusinessIdentifier>" & vbNewLine
ElseIf Left(dunsnumber, 1) = "A" Then
StrHTML = StrHTML & "<GlobalBusinessIdentifier>00-339-6256-0003</GlobalBusinessIdentifier>" & vbNewLine
Else
StrHTML = StrHTML & "<GlobalBusinessIdentifier>00-339-6256</GlobalBusinessIdentifier>" & vbNewLine
End If
StrHTML = StrHTML & "<businessName>" & vbNewLine
StrHTML = StrHTML & "<FreeFormText>Vitronic Promotional Group</FreeFormText>" & vbNewLine
StrHTML = StrHTML & "</businessName>" & vbNewLine
StrHTML = StrHTML & "</BusinessDescription>" & vbNewLine
StrHTML = StrHTML & "<GlobalPartnerClassificationCode>Supplier</GlobalPartnerClassificationCode>" & vbNewLine
StrHTML = StrHTML & "<PhysicalAddress>" & vbNewLine
StrHTML = StrHTML & "<addressLine1>" & vbNewLine
StrHTML = StrHTML & "<FreeFormText>4680 Parkway Drive Suite 200</FreeFormText>" & vbNewLine
StrHTML = StrHTML & "</addressLine1>" & vbNewLine
StrHTML = StrHTML & "<cityName>" & vbNewLine
StrHTML = StrHTML & "<FreeFormText>Mason</FreeFormText>" & vbNewLine
StrHTML = StrHTML & "</cityName>" & vbNewLine
StrHTML = StrHTML & "<GlobalCountryCode>US</GlobalCountryCode>" & vbNewLine
StrHTML = StrHTML & "<NationalPostalCode>45040</NationalPostalCode>" & vbNewLine
StrHTML = StrHTML & "<regionName>" & vbNewLine
StrHTML = StrHTML & "<FreeFormText>Ohio</FreeFormText>" & vbNewLine
StrHTML = StrHTML & "</regionName>" & vbNewLine
StrHTML = StrHTML & "</PhysicalAddress>" & vbNewLine
StrHTML = StrHTML & "</PartnerDescription>" & vbNewLine
StrHTML = StrHTML & "</PartnerRoleDescription>" & vbNewLine
StrHTML = StrHTML & "</fromRole>" & vbNewLine
'Document Info about this document
StrHTML = StrHTML & "<GlobalDocumentFunctionCode>Response</GlobalDocumentFunctionCode>" & vbNewLine
StrHTML = StrHTML & "<OrderStatus>" & vbNewLine
StrHTML = StrHTML & "<GlobalNotificationReasonCode>Periodic Status Update</GlobalNotificationReasonCode>" & vbNewLine
StrHTML = StrHTML & "<PurchaseOrder>" & vbNewLine
StrHTML = StrHTML & "<GlobalPurchaseOrderStatusCode>Accept</GlobalPurchaseOrderStatusCode>" & vbNewLine
StrHTML = StrHTML & "<GlobalPurchaseOrderTypeCode>Packaged Product</GlobalPurchaseOrderTypeCode>" & vbNewLine
'ProductLineItem Product line Information
'Specify db connection for detail line info in ord_list
'm_Conn2.Open "DSN=perfection;UID=crystal;PWD=crystal"
'sqltext2 = "SELECT *, ord_list.ordered * ord_list.price as Total From orders, ord_list Where orders.order_no = ('" & m_RS!order_no & "') AND ord_list.order_no = ('" & m_RS!order_no & "')"
SqlText2 = "SELECT orders.routing, orders.status, ord_list.ordered, ord_list.price, ord_list.description, ord_list.ordered * ord_list.price as Total, ord_list.line_no,"
SqlText2 = SqlText2 & "Case orders.routing "
SqlText2 = SqlText2 & "when 'airborne' then 'Air Economy' "
SqlText2 = SqlText2 & "when 'Fed10:30' then 'Primary Service Area - Next Day by 10:30 A.M.' "
SqlText2 = SqlText2 & "when 'Fedsat' then 'Saturday' "
SqlText2 = SqlText2 & "when 'Fedxsd' then 'Next Day Air' "
SqlText2 = SqlText2 & "when 'Pair' then 'Overnight' "
SqlText2 = SqlText2 & "when 'pmins' then 'Regular' "
SqlText2 = SqlText2 & "when 'ppins' then 'Regular' "
SqlText2 = SqlText2 & "when 'tf' then 'Passenger Service' "
SqlText2 = SqlText2 & "when 'upsam' then 'Overnight' "
SqlText2 = SqlText2 & "when 'upsb' then 'Second Day Air' "
SqlText2 = SqlText2 & "when 'UPSG' then 'Standard Ground' "
SqlText2 = SqlText2 & "when 'upso' then 'Three Day Service' "
SqlText2 = SqlText2 & "when 'uspost' then 'Regular' "
SqlText2 = SqlText2 & "Else 'Not Served' "
SqlText2 = SqlText2 & "End 'ShipMethod', "
SqlText2 = SqlText2 & "Case orders.Status "
SqlText2 = SqlText2 & "when 'N' then 'Active' "
SqlText2 = SqlText2 & "when 'T' then 'Closed' "
SqlText2 = SqlText2 & "when 'A' then 'Pending' "
SqlText2 = SqlText2 & "when 'P' then 'Active' "
SqlText2 = SqlText2 & "when 'Q' then 'Active' "
SqlText2 = SqlText2 & "when 'S' then 'Closed' "
SqlText2 = SqlText2 & "when 'V' then 'Cancelled' Else ' ' End 'OrderStatus' From orders, ord_list Where ord_list.orig_part_no <> 'VOCEXTENDED' AND orders.order_no = ('" & m_RS!order_no & "') AND ord_list.order_no = ('" & m_RS!order_no & "')"
'Debug.Print SqlText2
'm_RS2.Open SqlText2, m_Conn2
Set m_RS2 = m_Conn.Execute(SqlText2)
m_Conn.CommandTimeout = 0
counter = 1
While Not m_RS2.EOF
StrHTML = StrHTML & "<ProductLineItem>" & vbNewLine
StrHTML = StrHTML & "<buyerLineItem>" & vbNewLine
StrHTML = StrHTML & "<LineNumber>" & counter & "</LineNumber>" & vbNewLine
StrHTML = StrHTML & "</buyerLineItem>" & vbNewLine
'StrHTML = StrHTML & "<ProductLineItem>" & vbNewLine
StrHTML = StrHTML & "<GlobalLineItemStatusCode>" & m_RS!OrderStatus & "</GlobalLineItemStatusCode>" & vbNewLine
StrHTML = StrHTML & "<GlobalProductUnitOfMeasureCode>Each</GlobalProductUnitOfMeasureCode>" & vbNewLine
StrHTML = StrHTML & "<GlobalPurchaseOrderStatusCode>Accept</GlobalPurchaseOrderStatusCode>" & vbNewLine
StrHTML = StrHTML & "<LineNumber>" & m_RS2!line_no & "</LineNumber>" & vbNewLine
StrHTML = StrHTML & "<OrderShippingInformation>" & vbNewLine
StrHTML = StrHTML & "<CarrierInformation>" & vbNewLine
StrHTML = StrHTML & "<GlobalCarrierCode>UPSN</GlobalCarrierCode>" & vbNewLine
StrHTML = StrHTML & "</CarrierInformation>" & vbNewLine
StrHTML = StrHTML & "<GlobalShipmentTermsCode>FOB</GlobalShipmentTermsCode>" & vbNewLine
StrHTML = StrHTML & "<GlobalShippingServiceLevelCode>" & m_RS2!ShipMethod & "</GlobalShippingServiceLevelCode>" & vbNewLine
StrHTML = StrHTML & "</OrderShippingInformation>" & vbNewLine
StrHTML = StrHTML & "<OrderStatusQuantity>" & vbNewLine
StrHTML = StrHTML & "<GlobalOrderQuantityTypeCode>Scheduled</GlobalOrderQuantityTypeCode>" & vbNewLine
StrHTML = StrHTML & "<ProductQuantity>" & m_RS2!ordered & "</ProductQuantity>" & vbNewLine
StrHTML = StrHTML & "</OrderStatusQuantity>" & vbNewLine
StrHTML = StrHTML & "<ProductIdentification>" & vbNewLine
StrHTML = StrHTML & "<GlobalProductIdentifier>" & m_RS2!Description & "</GlobalProductIdentifier>" & vbNewLine
StrHTML = StrHTML & "</ProductIdentification>" & vbNewLine
StrHTML = StrHTML & "<requestedEvent>" & vbNewLine
StrHTML = StrHTML & "<TransportationEvent>" & vbNewLine
'ISO 8601 Date Specification
EventDate = CStr(m_RS!sch_ship_date)
EventDate = Left(EventDate, 10)
EventMonth = Left(EventDate, 2)
EventDay = Mid(EventDate, 4, 2)
EventYear = Right(EventDate, 4)
EventDate = EventYear + EventMonth + EventDay + "Z"
'Account for NULL values in the cancel_date field in orders table
If (Not (IsNull(m_RS("cancel_date")))) Then
StrHTML = StrHTML & "<DateStamp>" & EventDate & "</DateStamp>" & vbNewLine
Else
StrHTML = StrHTML & "<DateStamp>00/00/00</DateStamp>" & vbNewLine
End If
'StrHTML = StrHTML & "<DateStamp>00/00/00</DateStamp>" & vbNewLine
StrHTML = StrHTML & "<GlobalTransportEventCode>Ship</GlobalTransportEventCode>" & vbNewLine
StrHTML = StrHTML & "</TransportationEvent>" & vbNewLine
StrHTML = StrHTML & "</requestedEvent>" & vbNewLine
StrHTML = StrHTML & "<totalLineItemAmount>" & vbNewLine
StrHTML = StrHTML & "<FinancialAmount>" & vbNewLine
StrHTML = StrHTML & "<GlobalCurrencyCode>USD</GlobalCurrencyCode>" & vbNewLine
StrHTML = StrHTML & "<MonetaryAmount>" & m_RS2!Total & "</MonetaryAmount>" & vbNewLine
StrHTML = StrHTML & "</FinancialAmount>" & vbNewLine
StrHTML = StrHTML & "</totalLineItemAmount>" & vbNewLine
StrHTML = StrHTML & "<unitPrice>" & vbNewLine
StrHTML = StrHTML & "<FinancialAmount>" & vbNewLine
StrHTML = StrHTML & "<GlobalCurrencyCode>USD</GlobalCurrencyCode>" & vbNewLine
StrHTML = StrHTML & "<MonetaryAmount>" & m_RS2!price & "</MonetaryAmount>" & vbNewLine
StrHTML = StrHTML & "</FinancialAmount>" & vbNewLine
StrHTML = StrHTML & "</unitPrice>" & vbNewLine
StrHTML = StrHTML & "</ProductLineItem>" & vbNewLine
counter = counter + 1
m_RS2.MoveNext
Wend
'Set m_RS2 = Nothing
'm_Conn2.Close
'Set m_Conn2 = Nothing
StrHTML = StrHTML & "<proprietaryInformation>" & vbNewLine
StrHTML = StrHTML & "<FreeFormText>" & m_RS!order_no & "</FreeFormText>" & vbNewLine
StrHTML = StrHTML & "</proprietaryInformation>" & vbNewLine
StrHTML = StrHTML & "<purchaseOrderIdentifier>" & vbNewLine
StrHTML = StrHTML & "<ProprietaryDocumentIdentifier>" & m_RS!cust_po & "</ProprietaryDocumentIdentifier>" & vbNewLine
StrHTML = StrHTML & "</purchaseOrderIdentifier>" & vbNewLine
StrHTML = StrHTML & "<requestedEvent>" & vbNewLine
StrHTML = StrHTML & "<TransportationEvent>" & vbNewLine
'StrHTML = StrHTML & "<DateStamp>" & m_RS!cancel_date & "</DateStamp>" & vbNewLine
'Account for NULL values in the cancel_date field in orders table
If (Not (IsNull(m_RS("cancel_date")))) Then
StrHTML = StrHTML & "<DateStamp>" & EventDate & "</DateStamp>" & vbNewLine
Else
StrHTML = StrHTML & "<DateStamp>00/00/00</DateStamp>" & vbNewLine
End If
StrHTML = StrHTML & "<GlobalTransportEventCode>Ship</GlobalTransportEventCode>" & vbNewLine
StrHTML = StrHTML & "</TransportationEvent>" & vbNewLine
StrHTML = StrHTML & "</requestedEvent>" & vbNewLine
StrHTML = StrHTML & "<scheduledEvent>" & vbNewLine
StrHTML = StrHTML & "<TransportationEvent>" & vbNewLine
'ISO 8601 Date Specification
ShipDate = CStr(m_RS!sch_ship_date)
ShipDate = Left(ShipDate, 10)
ShipMonth = Left(ShipDate, 2)
ShipDay = Mid(ShipDate, 4, 2)
ShipYear = Right(ShipDate, 4)
ShipDate = ShipYear + ShipMonth + ShipDay + "Z"
StrHTML = StrHTML & "<DateStamp>" & ShipDate & "</DateStamp>" & vbNewLine
StrHTML = StrHTML & "<GlobalTransportEventCode>Ship</GlobalTransportEventCode>" & vbNewLine
StrHTML = StrHTML & "</TransportationEvent>" & vbNewLine
StrHTML = StrHTML & "</scheduledEvent>" & vbNewLine
StrHTML = StrHTML & "<shipTo>" & vbNewLine
StrHTML = StrHTML & "<PartnerDescription>" & vbNewLine
StrHTML = StrHTML & "<BusinessDescription>" & vbNewLine
StrHTML = StrHTML & "<businessName>" & vbNewLine
StrHTML = StrHTML & "<FreeFormText><![CDATA[" & m_RS!ship_to_name & "]]></FreeFormText>" & vbNewLine
StrHTML = StrHTML & "</businessName>" & vbNewLine
StrHTML = StrHTML & "</BusinessDescription>" & vbNewLine
StrHTML = StrHTML & "<PhysicalAddress>" & vbNewLine
StrHTML = StrHTML & "<addressLine1>" & vbNewLine
StrHTML = StrHTML & "<FreeFormText><![CDATA[" & m_RS!ship_to_add_1 & "]]></FreeFormText>" & vbNewLine
StrHTML = StrHTML & "</addressLine1>" & vbNewLine
StrHTML = StrHTML & "<addressLine2>" & vbNewLine
StrHTML = StrHTML & "<FreeFormText><![CDATA[" & m_RS!ship_to_add_2 & "]]></FreeFormText>" & vbNewLine
StrHTML = StrHTML & "</addressLine2>" & vbNewLine
StrHTML = StrHTML & "<cityName>" & vbNewLine
StrHTML = StrHTML & "<FreeFormText>" & m_RS!ship_to_add_3 & "</FreeFormText>" & vbNewLine
StrHTML = StrHTML & "</cityName>" & vbNewLine
StrHTML = StrHTML & "<GlobalCountryCode>US</GlobalCountryCode>" & vbNewLine
StrHTML = StrHTML & "<NationalPostalCode>" & m_RS!ship_to_add_5 & "</NationalPostalCode>" & vbNewLine
StrHTML = StrHTML & "<regionName>" & vbNewLine
StrHTML = StrHTML & "<FreeFormText>" & m_RS!ship_to_add_4 & "</FreeFormText>" & vbNewLine
StrHTML = StrHTML & "</regionName>" & vbNewLine
StrHTML = StrHTML & "</PhysicalAddress>" & vbNewLine
StrHTML = StrHTML & "</PartnerDescription>" & vbNewLine
StrHTML = StrHTML & "</shipTo>" & vbNewLine
StrHTML = StrHTML & "</PurchaseOrder>" & vbNewLine
StrHTML = StrHTML & "</OrderStatus>" & vbNewLine
StrHTML = StrHTML & "<thisDocumentGenerationDateTime>" & vbNewLine
'ISO 8601 Specification
DocumentDate = Right(Date, 4) + Left(Date, 2) + Mid(Date, 4, 2) + "Z"
StrHTML = StrHTML & "<DateTimeStamp>" & DocumentDate & "</DateTimeStamp>" & vbNewLine
StrHTML = StrHTML & "</thisDocumentGenerationDateTime>" & vbNewLine
StrHTML = StrHTML & "<thisDocumentIdentifier>" & vbNewLine
StrHTML = StrHTML & "<ProprietaryDocumentIdentifier></ProprietaryDocumentIdentifier>" & vbNewLine
StrHTML = StrHTML & "</thisDocumentIdentifier>" & vbNewLine
StrHTML = StrHTML & "<toRole>" & vbNewLine
StrHTML = StrHTML & "<PartnerRoleDescription>" & vbNewLine
StrHTML = StrHTML & "<GlobalPartnerRoleClassificationCode>Distributor</GlobalPartnerRoleClassificationCode>" & vbNewLine
StrHTML = StrHTML & "<PartnerDescription>" & vbNewLine
StrHTML = StrHTML & "<BusinessDescription>" & vbNewLine
StrHTML = StrHTML & "<GlobalBusinessIdentifier>" & m_RS!db_num & "</GlobalBusinessIdentifier>" & vbNewLine
'StrHTML = StrHTML & "<GlobalBusinessIdentifier>98-765-4321</GlobalBusinessIdentifier>" & vbNewLine
StrHTML = StrHTML & "<businessName>" & vbNewLine
StrHTML = StrHTML & "<FreeFormText>" & m_RS!address_name & "</FreeFormText>" & vbNewLine
StrHTML = StrHTML & "</businessName>" & vbNewLine
StrHTML = StrHTML & "</BusinessDescription>" & vbNewLine
StrHTML = StrHTML & "</PartnerDescription>" & vbNewLine
StrHTML = StrHTML & "</PartnerRoleDescription>" & vbNewLine
StrHTML = StrHTML & "</toRole>" & vbNewLine
StrHTML = StrHTML & "</Pip3A6PurchaseOrderStatusNotification>"
'Generate Order Status XML File
Set fso = CreateObject("Scripting.FileSystemObject")
' Set HTMLfile = fso.CreateTextFile("c:\epsa " & m_RS!cust_po & ".xml", True)
'Set tso = New Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
Dim tso As Scripting.TextStream
Set tso = fso.CreateTextFile("c:\switch\out\3A6 " & m_RS!order_no & " " & Second(Now) & ".xml", True)
tmpHTML = strHeader
tmpHTML = tmpHTML + StrHTML
tso.WriteLine tmpHTML
StrHTML = ""
tmpHTML = ""
tso.Close
Set tso = Nothing
Set fso = Nothing
m_RS.MoveNext
Wend
m_RS.Close
Set m_RS = Nothing
Exit Sub
End Sub
Public Sub CloseRS()
If Not m_RS Is Nothing Then
m_RS.Close
Set m_RS = Nothing
End If
End Sub
Public Sub CloseDB()
m_Conn.Close
Set m_Conn = Nothing
End Sub
Private Sub Class_Initialize()
m_ConnString = ""
End Sub
Private Sub Class_Terminate()
CloseRS
CloseDB
End Sub
| 