Parcourir une ligne lettre par lettre

[Klaas]

Bonjour,

Mon problème est le suivant:

J'ai un code XML composé de 5 linges:
<maison>
<1eratage>
<salon><tapis><Dateachat>02022009</Dateachat><tapis><lieuachat>canapi</lieuachat></salon>
</1eretage>
</maison>

Pour le parcourir je le transforme en fichier texte et je le parcours ligne par ligne

Cependant je veux enlever des informations de ce XML, ici la partie en gras, pour pouvoir l'importer sous excel sans cette info.

Mon alfo consiste à parcourir lettre par lettre à partir de la ligne ou le début est <Salon>, mais ca ne marche pas:

Mon code est composé de plein de balise de ce type et je souhaite a chaque fois enlevé cette info, mais il ne marche pas, il ne traite pas la ligne en entier

Sub modifXMLLigneEtape2()


Dim CalculationTime As Single
CalculationTime = Timer

Dim TempLettre As String
Dim TempLigne As String
Dim TempFinMot As String
Dim TempLigneDelete As String
TempLigneDelete = "<Dateachat>"
Dim TempLigneDeleteFermeture As String
TempLigneDeleteFermeture = "</DateAchat>"
Dim TempSelectionDelete As String
Dim TempLigneSelectionAGarger As String


Open "h:\My Documents\Projet 3\essai.xml" For Input As #1
Open "h:\My Documents\Projet 3\Res_essai.xml" For Output Access Write As #2


Do While Not EOF(1)



Line Input #1, TempLigne



If Mid(TempLigne, 13, Len(TempLigneDelete)) = TempLigneDelete Then

TempSelectionDelete = Mid(TempLigne, 13, Len(TempLigneDelete))

Do While Right(TempSelectionDelete, Len(TempLigneDeleteFermeture)) <> TempLigneDeleteFermeture
Do While TempLigne = TempLigne
TempLettre = Input(1, TempLigne)
TempSelectionDelete = TempSelectionDelete & TempLettre
Loop
Loop
TempSelectionDelete = ""

Else
Print #2, TempLigne
Debug.Print TempLigne
End If

Loop

Close #1
Close #2

Debug.Print Timer - CalculationTime

End Sub

Comment faire ? Avez vous d'autres solutions totalement différentes ? Si oui, je le prends volontiers.

merci

 

[tototiti2008]

Re : Parcourir une ligne lettre par lettre

Re

11 c'est la longueur de "/Dateachat>"

 

[sousou]

Re : Parcourir une ligne lettre par lettre

Re bonjour
essaie ce code
utilisation d'objet system pour lire le fichier text ligne par ligne
Utilisation d'une table pour lister les balises à reconnaître

au fait 11 c'était la longuer de la balise de fin, ici je la calcule

Public table(20, 1)
Sub debut()

' chemin du fichier text
Filename = "D:\Documents and Settings\Sourbelle\Bureau\txt.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(Filename)
Set ts = f.OpenAsTextStream()
Do While (Not ts.AtEndOfStream)
s = ts.ReadLine
Call unephrase(s)
Loop



End Sub



Sub unephrase(phrase)
'tableau des balises à reconnaître
table(0, 0) = "<Dateachat"
table(0, 1) = "/Dateachat>"
table(1, 0) = "<expDate>"
table(1, 1) = "</expDate>"
For n = 0 To 1

deb = InStr(1, phrase, table(n, 0))
fin = InStr(1, phrase, table(n, 1)) + Len(table(n, 1))
If deb <> 0 Or fin <> Len(table(n, 1)) Then
maphrase = Left(phrase, deb - 1)
m2 = Right(phrase, Len(phrase) - fin)
maphrase = Left(phrase, deb) & Right(phrase, Len(phrase) - fin)
MsgBox maphrase
End If

Next
End Sub

 

[pierrejean]

Re : Parcourir une ligne lettre par lettre

Re

A tester:

Do While Not EOF(1)
Line Input #1, TempLigne
If InStr(TempLigne, TempLigneDelete) <> 0 Then
 x = InStr(TempLigne, TempLigneDelete)
 y = InStr(TempLigne, TempLigneDeleteFermeture)
 TempLigne = Left(TempLigne, x - 1) & Mid(TempLigne, y + Len(TempLigneDeleteFermeture))
End If
Loop

 

[Klaas]

Re : Parcourir une ligne lettre par lettre

Merci beaucoup à vous tous, vos codes m'ont été très utiles, j'ai réussi à faire mon algo

 

[pierrejean]

Re : Parcourir une ligne lettre par lettre

Re

pour l'edification des foules , peux-tu nous faire profiter du dit algo ?

 

[Klaas]

Re : Parcourir une ligne lettre par lettre

Le voici:

Sub modifXMLLigneEtape2()

    Dim CurrentPath As String
          CurrentPath = Application.ThisWorkbook.Path & "\"
        
    Dim CalculationTime As Single
          CalculationTime = Timer
    
    Dim TempLigne As String
    Dim TempLigneSelectionAGargerDebut As String
    Dim TempLigneSelectionAGargerFin As String
    
    Open CurrentPath & "Inté.xml" For Input As #1
    Open CurrentPath & "RESULTAT_FINAL.xml" For Output Access Write As #2
    
    Do While Not EOF(1)
    
        Line Input #1, TempLigne
        
        If TempLigne Like "*<baliseouvrante>*</baliseouvrante>*" Then
            TempLigneSelectionAGargerDebut = InStr(1, TempLigne, "<baliseouvrante>") - 1
            TempLigneSelectionAGargerFin = InStr(1, TempLigne, "</baliseouvrante>") + 16
            TempLigne = Left(TempLigne, TempLigneSelectionAGargerDebut) & Right(TempLigne, Len(TempLigne) - TempLigneSelectionAGargerFin)
            Debug.Print TempLigne
            Print #2, TempLigne
        
        Else
            Print #2, TempLigne
            Debug.Print TempLigne
        End If
    
    Loop
    
        Close #1
        Close #2
    
    Debug.Print Timer - CalculationTime
    
     'ActiveWorkbook.XmlImport URL:=Currenpath & "RESULTAT_FINAL.xml", _
        'ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$B$2")

End Sub