UtterAccess HomeUtterAccess Wiki

Welcome Guest ( Log In | Register )

Custom Search
Edit Discussion
> SplitXml    

Usage:

CODE

Private Sub Command0_Click()
   Dim strPath         As String
   Dim strInputFile    As String
   Dim strOutputName   As String
   Dim strNode         As String
   Dim lngNodes        As Long
   
   strPath = "C:\MyPath"
   strInputFile = "MyFile.xml"
   strOutputName = "MyFile_"
   strNode = "MyNode"
   lngNodes = Number of nodes in each chunk ' i.e. 10000
   
   SplitXml strPath, strInputFile, strOutputName, strNode, lngNodes

End Sub

Subroutine:

CODE

'-------------------------------------------------------------------------------------------------------------------
' SplitXml
' http://www.utteraccess.com/wiki/SplitXml
' Code courtesy of UtterAccess Wiki
' Original submission by Diego F.Pereira-Perdomo
' Licensed under Creative Commons License
' http://creativecommons.org/licenses/by-sa/3.0/
'
' You are free to use this code in any application,
' provided this notice is left unchanged.
'
' rev  date                          brief descripton
' 1.0  2013-10-27                    Splits an Xml file into a number of chunks.
'                                       strPath:       A string that contains the Path where the File is located.
'                                       strInputFile:  A string that contains the Name of the Input File.
'                                       strOutputName: A string that contains the Name of the Output Files.
'                                       strNode:       The Name of the Node.
'                                       lngNodes:      Number of Nodes of the type Node in each file.
'-------------------------------------------------------------------------------------------------------------------

Heading:

CODE

Option Compare Database
Option Explicit
   Const xmlHeading = "<?xml version='1.0' encoding='utf-8'?>"
   Const xmlFirst = "<root>"
   Const xmlLast = "</root>"
   
   Dim booW    As Boolean  ' Excludes nodes between the end node and the next start node
   Dim booN    As Boolean  ' A new file has to be created
   Dim lngC    As Long     ' Counts start nodes
   Dim lngF    As Long     ' File Number
   Dim strP    As String   ' Path
   Dim strO    As String   ' Output
   Dim fFile   As Long     ' FreeFile Number

Main Subroutine SplitXml:

CODE

Sub SplitXml(strPath As String, _
       strInputFile As String, _
      strOutputName As String, _
            strNode As String, _
           lngNodes As Long)
   
   Dim oFSO    As Scripting.FileSystemObject
   Dim oTSt    As Scripting.TextStream
   Dim strPF   As String
   
   strP = strPath
   strPF = strP & "\" & strInputFile
   strO = strOutputName

   Set oFSO = New Scripting.FileSystemObject
   Set oTSt = oFSO.OpenTextFile(strPF, ForReading)

   With oTSt

       Do While Not .AtEndOfStream
           txtStream Trim$(.ReadLine), strNode, lngNodes
       Loop

       If .AtEndOfStream Then
           EndXml
       End If
       .Close
   End With
   
'   Cleaning
   lngF = 0
   lngC = 0
   strP = ""
   strPF = ""
   strO = ""
   
   Set oTSt = Nothing
   Set oFSO = Nothing
   
End Sub

txtStream:

CODE

Sub txtStream(strRL As String, _
           strNode As String, _
          lngNodes As Long)
         
   booN = False

   Select Case True
       Case strRL Like "*<" & strNode & "[> ]*"
           booW = True
           IsNewFile lngNodes
           ValidTxt strRL
           CountUpNode
       Case strRL Like "*</" & strNode & "[> ]*"
           ValidTxt strRL
           booW = False
       Case Else
           ValidTxt strRL
   End Select
       
End Sub

ValidTxt:

CODE

Sub ValidTxt(strRL As String)

   If booW Then
       PrintXml strRL
   End If
   
End Sub

PrintXml:

CODE

Sub PrintXml(strRL As String)
   
   Select Case booN
       Case True
       
           Select Case lngF
               Case 0
                   NewXml strRL
               Case Else
                   EndXml
                   NewXml strRL
           End Select
           
           CountUpFile
           
       Case False
           ContentXml strRL
   End Select
   
End Sub

NewXml:

CODE

Sub NewXml(strRL As String)

   Dim strPF   As String
   Dim strFile As String
   
   fFile = FreeFile

   strFile = strO & lngF & ".xml"
   strPF = strP & "\" & strFile
   
   Open strPF For Output As #fFile
       Print #fFile, xmlHeading
       Print #fFile, xmlFirst
       Print #fFile, strRL
       
   Debug.Print lngF, Now()
       
End Sub

EndXml:

CODE

Sub EndXml()

   Print #fFile, xmlLast
   Close #fFile

End Sub

ContentXml:

CODE

Sub ContentXml(strRL As String)
   Print #fFile, strRL
End Sub

CountUpNode:

CODE

Function CountUpNode() As Long
   lngC = lngC + 1
End Function

IsNewFile:

CODE

Sub IsNewFile(lngNodes As Long)

   If lngC Mod lngNodes = 0 Then
       booN = True
   End If
   
End Sub

CountUpFile:

CODE

Sub CountUpFile()
   lngF = lngF + 1
End Sub
Edit Discussion
Custom Search


Thank you for your support!
This page has been accessed 1,870 times.  This page was last modified 02:06, 28 October 2013 by genoma111.   Disclaimers