
'----------------------------------------------------------------
' Hands-On 29-1
' No Code.
' Please follow the instructions in the book.
'----------------------------------------------------------------


'----------------------------------------------------------------
' Hands-On 29-2
' No Code.
' Please follow the instructions in the book.
'----------------------------------------------------------------


'----------------------------------------------------------------
' Hands-On 29-3
' No Code.
' Please follow the instructions in the book.
'----------------------------------------------------------------


'----------------------------------------------------------------
' Hands-On 29-4
' No Code.
' Please follow the instructions in the book.
'----------------------------------------------------------------



'----------------------------------------------------------------
' Hands-On 29-5
' Code location: \Acc07_HandsOn\ListCustOrders.txt
'----------------------------------------------------------------


'----------------------------------------------------------------
' Hands-On 29-6
' No Code.
' Please follow the instructions in the book.
'----------------------------------------------------------------


'----------------------------------------------------------------
' Hands-On 29-7
' No Code.
' Please follow the instructions in the book.
'----------------------------------------------------------------


'----------------------------------------------------------------
' Custom Project 29-1
' Code location: \Acc07_HandsOn\CustomerOrders.txt
'----------------------------------------------------------------



'----------------------------------------------------------------
' Code on Page  743
' Statements to be entered in the Immediate Window
'----------------------------------------------------------------

Application.ExportXML ObjectType:=acExportTable, DataSource:="Products", DataTarget:= "C:\Learn_XML\North_Products.xml", SchemaTarget:= "C:\Learn_XML\North_ProdSchema.xsd", PresentationTarget:= "C:\Learn_XML\North_ProdReport.xsl"
Application.ExportXML ObjectType:=acExportTable, DataSource:="Customers", DataTarget:="C:\Learn_XML\OneCustomer.xml", WhereCondition:="CustomerID = 'GROSR'"


'----------------------------------------------------------------
' Hands-On 29-8
'----------------------------------------------------------------

Sub Export_CustomerOrderDetails()
    Dim objAppl As New Access.Application
    Dim objOtherTbls As AdditionalData
    Dim strDBName As String
    
    strDBName = "C:\Acc07_HandsOn\Northwind.mdb"

    On Error GoTo ErrorHandler
    objAppl.OpenCurrentDatabase (strDBName)
       
    Set objOtherTbls = objAppl.CreateAdditionalData

    ' include the Orders and OrderDetails tables in export
    objOtherTbls.Add "Orders"
    objOtherTbls.Add "Order Details"

    ' export Customers, Orders, and Order Details table into
    ' one XML data file
    
    objAppl.ExportXML ObjectType:=acExportTable, _
      DataSource:="Customers", _
      DataTarget:="C:\Learn_XML\CustomerOrdersDetails.xml", _
      AdditionalData:=objOtherTbls

    MsgBox "Export operation completed successfully."

Exit_Here:
        On Error Resume Next
        objAppl.CloseCurrentDatabase
        Set objAppl = Nothing
        Exit Sub
ErrorHandler:
        MsgBox Err.Number & ": " & Err.Description
        Resume Exit_Here
End Sub


'----------------------------------------------------------------
' Custom Project 29-2
'----------------------------------------------------------------

Sub Export_InvoiceReport()
    Dim objAppl As New Access.Application
    Dim strDBName As String
    
    strDBName = "C:\Acc07_HandsOn\Northwind.mdb"

    On Error GoTo ErrorHandler
    objAppl.OpenCurrentDatabase (strDBName)
     
    objAppl.ExportXML ObjectType:=acExportReport, _
                 DataSource:="Invoice", _
                 DataTarget:="C:\Learn_XML\Invoice.xml", _
                 PresentationTarget:="C:\Learn_XML\Invoice.xsl", _
                 ImageTarget:="C:\Learn_XML", _
                 WhereCondition:="OrderID=11075"

     MsgBox "Export operation completed successfully."
     
Exit_Here:
        On Error Resume Next
        objAppl.CloseCurrentDatabase
        Set objAppl = Nothing
        Exit Sub
ErrorHandler:
        MsgBox Err.Number & ": " & Err.Description
        Resume Exit_Here
End Sub


'----------------------------------------------------------------
' Custom Project 29-3 - Part 1
' Code location: \Acc07_HandsOn\Extensions.txt
'----------------------------------------------------------------


'----------------------------------------------------------------
' Custom Project 29-3 - Part 2
'----------------------------------------------------------------

Sub Transform_Employees()
    Dim objAppl As New Access.Application
    Dim strDBName As String
    
    strDBName = "C:\Acc07_HandsOn\Northwind.mdb"

    On Error GoTo ErrorHandler
    objAppl.OpenCurrentDatabase (strDBName)
    
    ' use the ExportXML method to create a source XML data file

    objAppl.ExportXML ObjectType:=acExportTable, _
                DataSource:="Employees", _
                DataTarget:="C:\Learn_XML\InternalContacts.xml"

    MsgBox "The export operation completed successfully."

    ' use the TransformXML method to apply the stylesheet that transforms
    ' the source XML data file into another XML data file
    objAppl.TransformXML DataSource:="C:\Learn_XML\InternalContacts.xml", _
                TransformSource:="C:\Learn_XML\Extensions.xsl", _
                OutputTarget:="C:\Learn_XML\EmpExtensions.xml", _
                WellFormedXMLOutput:=False

    MsgBox "The transform operation completed successfully."
    
Exit_Here:
        On Error Resume Next
        objAppl.CloseCurrentDatabase
        Set objAppl = Nothing
        Exit Sub
ErrorHandler:
        MsgBox Err.Number & ": " & Err.Description
        Resume Exit_Here
End Sub


'----------------------------------------------------------------
' Custom Project 29-3 - Part 3, page 755
' Code location: \Acc07_HandsOn\Extensions_SortByEmp.txt
'----------------------------------------------------------------

Sub Transform_ContactsSort()
    Dim objAppl As New Access.Application
    Dim strDBName As String
    
    strDBName = "C:\Acc07_HandsOn\Northwind.mdb"

    On Error GoTo ErrorHandler
    objAppl.OpenCurrentDatabase (strDBName)
    
    ' use the ExportXML method to create a source XML data file
    objAppl.ExportXML ObjectType:=acExportTable, _
                DataSource:="Employees", _
                DataTarget:="C:\Learn_XML\InternalContacts.xml"

    MsgBox "The export operation completed successfully."

    ' use the TransformXML method to apply the stylesheet that transforms
    ' the source XML data file into another XML data file

    objAppl.TransformXML DataSource:="C:\Learn_XML\InternalContacts.xml", _
                 TransformSource:="C:\Learn_XML\Extensions_SortByEmp.xsl", _
                 OutputTarget:="C:\Learn_XML\EmpExtensions.xml", _
                 WellFormedXMLOutput:=False

    MsgBox "The transform operation completed successfully."
    
Exit_Here:
        On Error Resume Next
        objAppl.CloseCurrentDatabase
        Set objAppl = Nothing
        Exit Sub
ErrorHandler:
        MsgBox Err.Number & ": " & Err.Description
        Resume Exit_Here
End Sub


'----------------------------------------------------------------
' Code on page 757
'----------------------------------------------------------------

Sub Import_XMLFile()
    Application.ImportXML DataSource:="c:\Learn_XML\EmpExtensions.xml", _
                ImportOptions:=acStructureOnly

    MsgBox "The import operation completed successfully."

End Sub


'----------------------------------------------------------------
' Hands-On 29-9
'----------------------------------------------------------------

Sub ReadXMLDoc()
    Dim xmldoc As MSXML2.DOMDocument60
    Set xmldoc = New MSXML2.DOMDocument60

    xmldoc.async = False
    If xmldoc.Load("C:\Learn_XML\Shippers.xml") Then
        Debug.Print xmldoc.XML
        ' Debug.Print xmldoc.Text
    End If
End Sub


'----------------------------------------------------------------
' Hands-On 29-10
'----------------------------------------------------------------

Sub LearnAboutNodes()
    Dim xmldoc As MSXML2.DOMDocument60
    Dim xmlNode As MSXML2.IXMLDOMNode

    Set xmldoc = New MSXML2.DOMDocument60
    xmldoc.async = False

    xmldoc.Load ("C:\Learn_XML\Shippers.xml")
    If xmldoc.hasChildNodes Then
        Debug.Print "Number of child Nodes: " & xmldoc.childNodes.length
        For Each xmlNode In xmldoc.childNodes
            Debug.Print "Node name:" & xmlNode.nodeName
            Debug.Print vbTab & "Type:" & xmlNode.nodeTypeString _
                                        & "(" & xmlNode.nodeType & ")"
            Debug.Print vbTab & "Text: " & xmlNode.Text
        Next xmlNode
    End If
    Set xmlDoc = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 29-11
'----------------------------------------------------------------

Sub IterateThruElements()
    Dim xmldoc As MSXML2.DOMDocument60
    Dim xmlNode As MSXML2.IXMLDOMNode
    Dim xmlNodeList As MSXML2.IXMLDOMNodeList
    Dim myNode As MSXML2.IXMLDOMNode

    Set xmldoc = New MSXML2.DOMDocument60
    xmldoc.async = False
    xmldoc.Load ("C:\Learn_XML\Shippers.xml")
    Set xmlNodeList = xmldoc.getElementsByTagName("*")
    For Each xmlNode In xmlNodeList
        For Each myNode In xmlNode.childNodes
          If myNode.nodeType = NODE_TEXT Then
            Debug.Print xmlNode.nodeName & "=" & xmlNode.Text
          End If
        Next myNode
    Next xmlNode
    Set xmlDoc = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 29-12
'----------------------------------------------------------------

Sub SelectNodesByCriteria()
    Dim xmldoc As MSXML2.DOMDocument60
    Dim xmlNodeList As MSXML2.IXMLDOMNodeList
    Dim myNode As MSXML2.IXMLDOMNode

    Set xmldoc = New MSXML2.DOMDocument60
    xmldoc.async = False
    xmldoc.Load ("C:\Learn_XML\Shippers.xml")
    Set xmlNodeList = xmldoc.selectNodes("//Company")
    If Not (xmlNodeList Is Nothing) Then
        For Each myNode In xmlNodeList
            Debug.Print myNode.Text
            If myNode.Text = "Shipping Company A" Then
                myNode.Text = "Airborne Express"
                xmldoc.Save "C:\Learn_XML\Shippers.xml"
            End If
        Next myNode
    End If
    Set xmldoc = Nothing
End Sub


'----------------------------------------------------------------
' Code on page 764
'----------------------------------------------------------------

Sub SelectSingleNode()
    Dim xmldoc As MSXML2.DOMDocument60
    Dim xmlSingleNode As MSXML2.IXMLDOMNode

    Set xmldoc = New MSXML2.DOMDocument60
    xmldoc.async = False
    xmldoc.Load ("C:\Learn_XML\Shippers.xml")
    Set xmlSingleNode = xmldoc.SelectSingleNode("//Company")
    If xmlSingleNode Is Nothing Then
        Debug.Print "No nodes selected."
    Else
     Debug.Print xmlSingleNode.Text
    End If
    Set xmlDoc = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 29-13
'----------------------------------------------------------------

Sub SaveRst_ToXMLwithADO()
    Dim rst As ADODB.Recordset
    Dim conn As New ADODB.Connection

    Const strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" _
        & "Data Source=C:\Acc07_HandsOn\Northwind.mdb"

    ' open a connection to the database
    conn.Open strConn

    ' execute a select SQL statement against the database
    Set rst = conn.Execute("SELECT * FROM Products")

    ' delete the file if it exists
    On Error Resume Next
    Kill "C:\Learn_XML\Products_AttribCentric.xml"

    ' save the recordset as an XML file
    rst.Save "C:\Learn_XML\Products_AttribCentric.xml", adPersistXML

    ' cleanup
    Set rst = Nothing
    Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 29-14
' Code location: \Acc07_HandsOn\AttribToElem.txt
'----------------------------------------------------------------


'----------------------------------------------------------------
' Hands-On 29-15
'----------------------------------------------------------------

Sub ApplyStyleSheetAndImport()
    Dim myXMLDoc As New MSXML2.DOMDocument60
    Dim myXSLDoc As New MSXML2.DOMDocument60
    Dim newXMLDoc As New MSXML2.DOMDocument60
    
    myXMLDoc.async = False
    
    If myXMLDoc.Load("C:\Learn_XML\Products_AttribCentric.xml") Then
        myXSLDoc.Load "C:\Learn_XML\AttribToElem.xsl"
        ' apply the transformation
        If Not myXSLDoc Is Nothing Then
            myXMLDoc.transformNodeToObject myXSLDoc, newXMLDoc
            ' save the output in a new file
            newXMLDoc.Save "C:\Learn_XML\Products_Converted.xml"
            ' import to Access
            Application.ImportXML "C:\Learn_XML\Products_Converted.xml"
        End If
    End If
    
    ' cleanup
    Set myXMLDoc = Nothing
    Set myXSLDoc = Nothing
    Set newXMLDoc = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 29-16
' Code location: \Acc07_HandsOn\AttribToHTML.txt
'----------------------------------------------------------------


'----------------------------------------------------------------
' Hands-On 29-17
' Please follow the instructions in the book.
'----------------------------------------------------------------


'----------------------------------------------------------------
' Hands-On 29-18
'----------------------------------------------------------------

Sub OpenAdoFile()
    Dim rst As ADODB.Recordset
    Dim objExcel As Excel.Application
    Dim wkb As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim StartRange As Excel.Range
    Dim h as Integer

    Set rst = New ADODB.Recordset

    ' open your XML file and load it
    rst.Open "C:\Learn_XML\Products_AttribCentric.xml", "Provider=MSPersist"

    ' display the number of records
    MsgBox "There are " & rst.RecordCount & " records " & _
           "in this file."

    Set objExcel = New Excel.Application

    ' create a new Excel workbook
    Set wkb = objExcel.Workbooks.Add

    ' set a reference to the ActiveSheet
    Set wks = wkb.ActiveSheet

    ' make Excel application window visible
    objExcel.Visible = True

    ' copy field names as headings to the first row of the worksheet
        For h = 1 To rst.Fields.Count
            wks.Cells(1, h).Value = rst.Fields(h - 1).Name
        Next

    ' specify the cell range to receive the data (A2)
    Set StartRange = wks.Cells(2, 1)

    ' copy the records from the recordset beginning in cell A2
    StartRange.CopyFromRecordset rst

    ' autofit the columns to make the data fit
    wks.Range("A1").CurrentRegion.Select
    wks.Columns.AutoFit

    ' save the workbook
    wkb.SaveAs "C:\Learn_XML\ExcelReport.xls"

    Set objExcel = Nothing
    Set rst = Nothing
End Sub

