Page 1 sur 1
Récupérer de l'information dans du XML
Publié:
29 Nov 2005 à 20:55par 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