VBA/Excel/Access/Word/Excel/Excel XML

Compatibility Mode

 
Sub wkbkSave()
    Dim xlVersion As String
    Dim myxlOpenXMLWorkbook As String
    
    myxlOpenXMLWorkbook = "51"
    
    xlVersion = Application.Version
    
    Select Case xlVersion
        Case Is = "9.0", "10.0", "11.0"
            ActiveWorkbook.SaveAs FileName:="LegacyVersionExcel.xls"
        Case Is = "12.0"
            ActiveWorkbook.SaveAs FileName:="Excel2007Version", _
            FileFormat:=myxlOpenXMLWorkbook
    End Select
End Sub

Creating Your Own XSD

 
     Sub Create_XSD()
         Dim StrMyXml As String, MyMap As XmlMap
         Dim StrMySchema As String
         StrMyXml = "<EmployeeSales>"
         StrMyXml = StrMyXml & "<Employee>"
         StrMyXml = StrMyXml & "<Empid>999</Empid>"
         StrMyXml = StrMyXml & "<FirstName>Text</FirstName>"
         StrMyXml = StrMyXml & "<LastName>Text</LastName>"
         StrMyXml = StrMyXml & "<InvoiceNumber>999</InvoiceNumber>"
         StrMyXml = StrMyXml & "<InvoiceAmount>999</InvoiceAmount>"
         StrMyXml = StrMyXml & "</Employee>"
         StrMyXml = StrMyXml & "<Employee></Employee>"
         StrMyXml = StrMyXml & "</EmployeeSales>"
         Application.DisplayAlerts = False
         Set MyMap = ThisWorkbook.XmlMaps.add(StrMyXml)
         Application.DisplayAlerts = True
         StrMySchema = ThisWorkbook.XmlMaps(1).Schemas(1).XML
           Open "C:\StrMySchema.xsd" For Output As #1
           Print #1, StrMySchema
           Close #1
     End Sub

Exporting to an XML File

 
     Sub ExportToXmlFile()
         ActiveWorkbook.XmlMaps("EmployeeSales_Map").Export URL:=ThisWorkbook.Path & "\Exported.xml"
     End Sub

Export to XML file

 
Option Compare Database
Private Sub ExportTestsData()
    Dim objad As AdditionalData
    Set objad = Application.CreateAdditionalData
    objad.Add "Questions"
    objad(Item = "Questions").Add "Answers"
    Application.ExportXML acExportTable, "Tests", "c:\tests4.xml", "c:\tests4.xsd", AdditionalData:=objad
End Sub

Get Schema

 
     Sub GetSchema()
         Dim MySchema As String
         "Get the schema
         MySchema = ActiveWorkbook.XmlMaps("EmployeeSales_Map").Schemas(1).XML
         Open "C:\MySchema.xsd" For Output As #1
         Print #1, MySchema
         Close #1
     End Sub

Importing Data into an Existing XML Map

 
     Sub ImportXmlFromFile()
     ThisWorkbook.XmlMaps("EmployeeSales_Map").Import(ThisWorkbook.Path & "\EmployeeSales.xml")
     End Sub

Leveraging DOM and XPath to Manipulate XML Files

 
     Sub Load_ReadXMLDoc()
         Dim oMyDoc As DOMDocument
         Set oMyDoc = New DOMDocument
         oMyDoc.async = False
         oMyDoc.Load (ThisWorkbook.Path & "\SalesByRegion.xml")
         Debug.Print oMyDoc.XML
         Set oMyDoc = Nothing
     End Sub

Programmatically Changing XML Map Properties

 
     Sub ChangeXmlMapProperties()
         With ActiveWorkbook.XmlMaps("EmployeeSales_Map")
             .name = "New_Name"
             .ShowImportExportValidationErrors = False
             .SaveDataSourceDefinition = True
             .AdjustColumnWidth = True
             .PreserveColumnFilter = True
             .PreserveNumberFormatting = True
             .AppendOnImport = False
         End With
         ThisWorkbook.XmlMaps(1).name = "EmployeeSales_Map"
     End Sub

Refresh Your XML Data

 
     Sub RefreshXML()
          ThisWorkbook.XmlMaps("EmployeeSales_Map").DataBinding.Refresh
     End Sub

returns a workbook object with the XML data mapped to your spreadsheet:

 
Sub ImportXMLtoList()
     Dim strTargetFile As String
     Application.DisplayAlerts = False
     strTargetFile = ThisWorkbook.Path & "\Employee.xml"
     Workbooks.OpenXML FileName:=strTargetFile, LoadOption:=xlXmlLoadImportToList
     Application.DisplayAlerts = True
End Sub

Using DOM with ADO to Convert Excel Data to XML

 
Sub Convert_Excel_Data_to_XML()
     Dim oMyconnection As Connection
     Dim oMyrecordset As Recordset
     Dim oMyXML As DOMDocument
     Dim oMyWorkbook As String
     Set oMyconnection = New Connection
     Set oMyrecordset = New Recordset
     Set oMyXML = New DOMDocument
     oMyWorkbook = Application.ThisWorkbook.FullName
     oMyconnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                      "Data Source=" & oMyWorkbook & ";" & _
                      "Extended Properties=excel 8.0;" & _
                      "Persist Security Info=False"
     oMyrecordset.Open "Select * from [Sheet1$A1:D43]", oMyconnection, adOpenStatic
     oMyrecordset.save oMyXML, adPersistXML
     oMyXML.save (ThisWorkbook.Path & "\Output.xml")
         oMyrecordset.Close
         Set oMyconnection = Nothing
         Set oMyrecordset = Nothing
         Set oMyXML = Nothing
End Sub

XML transform

 
Private Sub TransformData()
                
    Application.TransformXML "c:\tests2.xml", "c:\transform.xsl", "c:\tests5.htm"
End Sub