Extraer a XML Access (Tablas, Consultas, Reportes) desde codigo vba

***   EL CODIGO  ***
 
Option Compare Database
Option Explicit
'***************************************************************
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&               Jefferson Jimenez (JJJT)                     &*
'&                 Cabimas - Venezuela                        &*
'&                   Agosto - 2010                            &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'&                                                            &*
'***************************************************************
'Creo un Enum para elegir la estructura a exportar
Enum OutXML
acExportTable = 0
acExportQuery = 1
acExportForm = 2
acExportReport = 3
acExportFunction = 10
End Enum
 
Public Sub ExportaXML(BD_Origen As String, _
                      Destino_XML As String, _
                      Optional Objt As OutXML, _
                      Optional frm As Form, _
                      Optional Rpt As Report, _
                      Optional StrDataSource As String, _
                      Optional cRiTeRio As String)
On Error GoTo ExpXML_Err
Dim base As Database 'Variable para la BD (puede ser interna o externa)
Dim Tabla As TableDef 'Variable para la Busqueda de tablas
'dim Qry as QueryDef 'Tambien pudiesemos hacerlos para las consultas
Dim objAD As AdditionalData 'Representa la colección de tablas y consultas que se incluirá en la tabla primaria exportada por el método ExportXML
   
  Set base = OpenDatabase(BD_Origen) 'Cargo la BD
  Set objAD = Application.CreateAdditionalData 'Cargo la coleccion
     'Segun sea el caso
     Select Case Objt
      Case 0
      'Si el StrDataSource esta vacio, quiere decir que seran todas las tablas
         If StrDataSource = "" Then
                With objAD
                 For Each Tabla In base.TableDefs 'Recorro las tablas activas de la BD
                    'No exporto las del sistema y dejo de ultima la del Form Activo (Necesaria)
                    If Left$(Tabla.Name, 4) <> "Msys" And Tabla.Name <> frm.RecordSource Then
                     .Add Tabla.Name 'Me las cargo
                    End If
                     Next Tabla
                 base.Close 'Cierro
                 End With
                'Exporto a XML agregando todas las tablas AdditionalData:=objAD
                Application.ExportXML Objt, frm.RecordSource, _
                                Destino_XML, AdditionalData:=objAD
         Else
               'De exportar por aqui significa que sera una sola tabla a consulta
                Application.ExportXML Objt, StrDataSource, Destino_XML
         End If
                                     
      Case 3
               'De tratarse de un Reporte
                Application.ExportXML Objt, Rpt.RecordSource, _
                              Destino_XML
      Case 1
               'Para exportar una consulta segun un filtro
               Application.ExportXML Objt, StrDataSource, _
                              Destino_XML, , , , , , cRiTeRio
     End Select
'Aviso si fue exitosa la exportacion
MsgBox "La Exportacion Fue Existosa" & vbCrLf & "Busque el Archivo XML en esta misma Carpeta", vbExclamation, "JJJT Access"
ExpXML_Exit:
    Exit Sub
ExpXML_Err:
    MsgBox Error$
    Resume ExpXML_Exit
End Sub
SelectionFile type iconFile nameDescriptionSizeRevisionTimeUser
ċ
Descargar		 Descargue el Ejemplo  389 kb v. 1 28 jul. 2010 9:54 Jefferson Jimenez
Comments