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

Материал из VB Эксперт
Перейти к: навигация, поиск

Compatibility Mode

   <source lang="vb">

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

</source>
   
  


Creating Your Own XSD

   <source lang="vb">

    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
</source>
   
  


Exporting to an XML File

   <source lang="vb">

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


Export to XML file

   <source lang="vb">

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

</source>
   
  


Get Schema

   <source lang="vb">

    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
</source>
   
  


Importing Data into an Existing XML Map

   <source lang="vb">

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


Leveraging DOM and XPath to Manipulate XML Files

   <source lang="vb">

    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
</source>
   
  


Programmatically Changing XML Map Properties

   <source lang="vb">

    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
</source>
   
  


Refresh Your XML Data

   <source lang="vb">

    Sub RefreshXML()
         ThisWorkbook.XmlMaps("EmployeeSales_Map").DataBinding.Refresh
    End Sub
</source>
   
  


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

   <source lang="vb">

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

</source>
   
  


Using DOM with ADO to Convert Excel Data to XML

   <source lang="vb">

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

</source>
   
  


XML transform

   <source lang="vb">

Private Sub TransformData()

   Application.TransformXML "c:\tests2.xml", "c:\transform.xsl", "c:\tests5.htm"

End Sub

</source>