Récupérer de l'information dans du XML

[Michael DELIQUE]

Code : Tout sélectionner

Public Function GetXMLValue(wSource As String, wTag As String,wTag2 As String) As String
   'Déclaration Varaible
   
   Dim Start_Tag As String
   Dim End_Tag As String
   Dim nbStartPosition As Integer
   Dim nbStartLen As Integer
   Dim nbEndPosition As Integer
   
   On Error Goto ErreurGetXMLValue
   
   If Trim(wSource) = "" Then
      GetXMLValue = ""
      Exit Function
   End If
   If Trim(wTag) = "" Then
      GetXMLValue = ""
      Exit Function
   End If
   
   If Trim(wTag2) = "" Then
      Start_Tag = "<" + wTag + ">"
      End_Tag  = "</" + wTag + ">"
   Else
      Start_Tag = wTag
      End_Tag  =wTag2
   End If
   
   nbStartPosition = Instr (wSource, Start_Tag)
   nbStartLen = Len ( Start_Tag )
   If nbStartPosition > 0 Then
      nbEndPosition = Instr (Right$ ( wSource, Len ( wSource ) - nbStartPosition ) , End_Tag )
      If nbEndPosition > 0 Then
         GetXMLValue = Mid$ ( wSource , nbStartPosition + nbStartLen , Instr ( nbStartPosition + nbStartLen, wSource, End_Tag) - (nbStartPosition + nbStartLen ) )
      Else
         GetXMLValue = Mid$ (wSource, Instr( wSource, Start_Tag) + Len (Start_Tag) , Len (wSource))
      End If
   Else
      GetXMLValue = ""
   End If
   
   Start_Tag = ""
   End_Tag  = ""
   nbStartPosition = 0
   nbStartLen = 0
   nbEndPosition = 0
   
   Exit Function
ErreurGetXMLValue:
   Msgbox "(GetXMLValue)"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   GetXMLValue = ""
   Exit Function

Code : Tout sélectionner

Public Function GetXMLValueMultiple(wSource As String, wTag As String,wTag2 As String) As Variant
   '     Déclaration variable
   Dim TexteTemp As String
   Dim i As Integer
   Dim lstValue List As String
   Dim Start_Tag As String
   Dim End_Tag As String
   Dim nbStartPosition As Integer
   Dim nbStartLen As Integer
   Dim nbEndPosition As Integer
   
   On Error Goto ErreurGetXMLValueMultiple
   
   If Trim(wSource) = "" Then
      lstValue(0) = ""
      GetXMLValueMultiple = lstValue(0)
      Erase lstValue
      Exit Function
   End If
   If Trim(wTag) = "" Then
      lstValue(0) = ""
      GetXMLValueMultiple = lstValue(0)
      Erase lstValue
      Exit Function
   End If
   
   If Trim(wTag2) = "" Then
      Start_Tag = "<" + wTag + ">"
      End_Tag  = "</" + wTag + ">"
   Else
      Start_Tag = wTag
      End_Tag  =wTag2
   End If
   
   Erase lstValue
   
   TexteTemp = wSource
   
   nbStartPosition = Instr (TexteTemp, Start_Tag)
   nbStartLen = Len ( Start_Tag )
   
   i = 0
   While ( nbStartPosition > 0  )
      
      nbEndPosition = Instr (Right$ ( TexteTemp, Len ( TexteTemp ) - nbStartPosition ) , End_Tag )
      
      If nbEndPosition > 0 Then
         lstValue(i) = Mid$ ( TexteTemp , nbStartPosition + nbStartLen , Instr ( nbStartPosition + nbStartLen, TexteTemp, End_Tag) - (nbStartPosition + nbStartLen) )
         TexteTemp = Right$ ( TexteTemp, Len ( TexteTemp ) - (nbStartPosition+nbEndPosition+Len(End_Tag) - 1))
         i = i + 1
      Else
         lstValue(i) = Mid$ (TexteTemp, Instr( TexteTemp, Start_Tag) + Len (Start_Tag) , Len (TexteTemp))
         TexteTemp = ""
         i = i + 1
      End If
      
      nbStartPosition = Instr (TexteTemp, Start_Tag)
      nbStartLen = Len ( Start_Tag )
      
   Wend
   
   GetXMLValueMultiple = lstValue
   
   Erase lstValue
   Start_Tag = ""
   End_Tag  = ""
   TexteTemp = ""
   nbStartPosition = 0
   nbStartLen = 0
   nbEndPosition = 0
   
   Exit Function
ErreurGetXMLValueMultiple:
   Msgbox "(GetXMLValueMultiple)"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   Erase lstValue
   lstValue(0) = ""
   GetXMLValueMultiple = lstValue(0)
   Erase lstValue
   Exit Function
End Function