** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Tus Funciones Favoritas & Aportaciones & Artí­culos
  Mensajes nuevos Mensajes nuevos RSS - VBA: Access - XML - SAX. Cuenta Nodos
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoVBA: Access - XML - SAX. Cuenta Nodos

 Responder Responder
Autor
Mensaje
genoma111 Ver desplegable
Administrador
Administrador
Avatar

Unido: 28/Marzo/2011
Localización: ...
Estado: Sin conexión
Puntos: 3248
Enlace directo a este mensaje Tema: VBA: Access - XML - SAX. Cuenta Nodos
    Enviado: 09/Noviembre/2013 a las 11:16
Cuenta la cantidad de veces que un determinado nodo/elemento se encuentra en un documento XML.

Uso:

Private Sub Command0_Click()
    Dim strPath     As String
    Dim strFile     As String
    Dim strNode     As String
   
    strPath = CurrentProject.Path
    strFile = "El archivo.xml"
    strNode = "El nodo"
   
    Call SaxCountNodes(strPath, strFile, strNode)
   
End Sub

Módulo General:

'-------------------------------------------------------------------------------------------
' Name:         SaxCountNodes
' Purpose:      Llama a la clase clsSaxContentHandlerCountNodes.
' Description:  strPath = La ruta completa.
'               strFile = El nombre del archivo.
'               strNode = El nombre del nodo.
' Author:       Diego F.Pereira-Perdomo
' Date:         Oct-28-2013
' References:   Requiere la librería Microsoft XML, v6.0
'               Requiere la clase clsSaxContentHandlerCountNodes
'-------------------------------------------------------------------------------------------

Option Compare Database
Option Explicit
Sub SaxCountNodes(strPath As String, _
                  strFile As String, _
                  strNode As String)
On Error GoTo SaxCountNodes_Error

    Dim strPF           As String
    Dim reader          As SAXXMLReader60
    Dim contentHandler  As clsSaxContentHandlerCountNodes
    Dim errorHandler    As clsSAXErrorHandler
   
    Set reader = New SAXXMLReader60
    Set contentHandler = New clsSaxContentHandlerCountNodes
    Set errorHandler = New clsSAXErrorHandler
    Set reader.contentHandler = contentHandler
    Set reader.errorHandler = errorHandler
   
    strPath = strPath & "\"
    strPF = strPath & strFile
    contentHandler.SetFilterCriteria (strNode)
    reader.parseURL (strPF)
    MsgBox "There are " & contentHandler.lngC & " " & strNode & " nodes."
   
    Set reader.errorHandler = Nothing
    Set reader.contentHandler = Nothing
    Set errorHandler = Nothing
    Set contentHandler = Nothing
    Set reader = Nothing

    Exit Sub
SaxCountNodes_Error:
    If Not contentHandler.errorHappen Then
        Debug.Print "**** Error **** " & Err.Number & " : " & Err.Description
    End If
End Sub

La clase clsSaxContentHandlerCountNodes:

'-------------------------------------------------------------------------------------------
' Name:         clsSaxContentHandlerCountNodes
' Purpose:      Cuenta el número de nodos/elements en el documento
' Author:       Diego F.Pereira-Perdomo
' Date:         Oct-28-2013
' References:   Requiere la librería Microsoft XML, v6.0
' Basado en el ejemplo "Create a Simple Filter" publicado en el msdn
' http://msdn.microsoft.com/en-us/library/ms759197%28v=vs.85%29.aspx
'-------------------------------------------------------------------------------------------
Option Compare Database
Option Explicit
   
    Implements IVBSAXContentHandler
    Implements IVBSAXErrorHandler
   
    Public oContentHandler  As IVBSAXContentHandler
    Public oErrorHandler    As IVBSAXErrorHandler
    Public errorHappen      As Boolean
    Public lngC             As Long
   
    Dim FilterCriteria      As String
'-------------------------------------------------------------------------------------------

Private Sub IVBSAXContentHandler_startDocument()
'
End Sub
'-------------------------------------------------------------------------------------------

Private Sub IVBSAXContentHandler_startPrefixMapping(strPrefix As String, _
                                                       strURI As String)
End Sub
'-------------------------------------------------------------------------------------------

Private Sub IVBSAXContentHandler_startElement(strNamespaceURI As String, _
                                                 strLocalName As String, _
                                                     strQName As String, _
                                            ByVal oAttributes As MSXML2.IVBSAXAttributes)
                                           
    Select Case strLocalName
   
        Case FilterCriteria
       
            lngC = lngC + 1
                       
    End Select

End Sub
'-------------------------------------------------------------------------------------------

Private Sub IVBSAXContentHandler_characters(strChars As String)
'
End Sub
'-------------------------------------------------------------------------------------------

Private Property Set IVBSAXContentHandler_documentLocator(ByVal RHS As MSXML2.IVBSAXLocator)
'
End Property
'-------------------------------------------------------------------------------------------

Private Sub IVBSAXContentHandler_ignorableWhitespace(strChars As String)
'
End Sub
'-------------------------------------------------------------------------------------------

Private Sub IVBSAXContentHandler_processingInstruction(strTarget As String, _
                                                         strData As String)
'
End Sub
'-------------------------------------------------------------------------------------------

Private Sub IVBSAXContentHandler_skippedEntity(strName As String)
'
End Sub
'-------------------------------------------------------------------------------------------

Private Sub IVBSAXContentHandler_endElement(strNamespaceURI As String, _
                                               strLocalName As String, _
                                                   strQName As String)
'
End Sub
'-------------------------------------------------------------------------------------------

Private Sub IVBSAXContentHandler_endPrefixMapping(strPrefix As String)
'
End Sub
'-------------------------------------------------------------------------------------------

Private Sub IVBSAXContentHandler_endDocument()
'
End Sub
'-------------------------------------------------------------------------------------------

Private Sub IVBSAXErrorHandler_error(ByVal oLocator As MSXML2.IVBSAXLocator, _
                                    strErrorMessage As String, _
                                   ByVal nErrorCode As Long)

End Sub
'-------------------------------------------------------------------------------------------

Private Sub IVBSAXErrorHandler_fatalError(ByVal oLocator As MSXML2.IVBSAXLocator, _
                                         strErrorMessage As String, _
                                        ByVal nErrorCode As Long)
                                       
    Debug.Print strErrorMessage & nErrorCode
    errorHappen = True
   
End Sub
'-------------------------------------------------------------------------------------------

Private Sub IVBSAXErrorHandler_ignorableWarning(ByVal oLocator As MSXML2.IVBSAXLocator, _
                                               strErrorMessage As String, _
                                              ByVal nErrorCode As Long)
End Sub
'-------------------------------------------------------------------------------------------

Public Sub SetFilterCriteria(elementname)

    FilterCriteria = elementname
   
End Sub
'-------------------------------------------------------------------------------------------

Private Sub Initialize()

    errorHappen = False
   
End Sub
'-------------------------------------------------------------------------------------------




Editado por genoma111 - 09/Noviembre/2013 a las 21:51
"To VBA or not to VBA... that's the question" DFP
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable