Sujet Précédent Sujet Suivant

LIRE DONNE D'UN FICHIER.htlm et non d'une page html en vb6

Résolu
FOUNI Messages postés 28 Date d'inscription dimanche 8 juillet 2007 Statut Membre Dernière intervention 8 mars 2013 - 13 juil. 2009 à 12:24
FOUNI Messages postés 28 Date d'inscription dimanche 8 juillet 2007 Statut Membre Dernière intervention 8 mars 2013 - 23 juil. 2009 à 19:12
Bonjour,

je programmais en vba et je programme depuis peu en vb6

après avoir rechercher sur le forum des explications et un exemple de programmation ado , je me tourne vers vous pour m'aider

voilà
j'ai un fichier (dont le nom est   dud.html  ) qui contient   les données d'un logitiel , et je n'ai pas le choix de l'extension 
ce fichier est dans un répertoire c:\documents and setting\tout\, mais il pourra changer de place dans l'avenir
ce fichier s'ouvre avec excel
je pourrai vous le joindre mais je ne sais pas comment faire, désolé, d'ailleur si vous pouvez me l'enseigner merci
j'ai un projet    VB6 avec un MSflexgrid1 

j'aimerai   récupérer les donner de ce fichier qui contient des cases vide également et le placer dans le MSflexgrid1

mais sans l'ouvrir  avec une connextion style ado 

j'ai besoin d'un code pour pouvoir modifier le chemin si nécessaire

je sais récupérer des données d'un fichier excel  mais pas  quand l'extension est .html cela ne marche pas

merci
merci
si vous pouvez m'aider

 

    

27 réponses

Précédent
  • 1
  • 2
Réponse 21 / 27
FOUNI Messages postés 28 Date d'inscription dimanche 8 juillet 2007 Statut Membre Dernière intervention 8 mars 2013
18 juil. 2009 à 18:18
SALUT

ENCORE MERCI

JE vais travailler avec tes infos très précieuses , garde le code sous le coude stp,
ne t'inpatiente pas , je cherche , et il est possible que je m'absente 1 semaine en vacances

merci pour l'info pour le livre , j'en ai un qui s'appelle( VISUAL BASIC 6.0 de diane zak edition reynald goulet avec cd exo ), mais certaines explications sont pas assez détaillés


je ne lache pas l'affaire



bonne soirée
0
Réponse 22 / 27
FOUNI Messages postés 28 Date d'inscription dimanche 8 juillet 2007 Statut Membre Dernière intervention 8 mars 2013
19 juil. 2009 à 17:29
RE -SALUT

J' ai essayé de faire la boucle mais je n'arrive pas , je pense qu'il faut utilse DO WHILE LOOP
jusqu'à présent , j'ai utilisé des boucles for next simple avec des variables correspondant à la première et dernières celules dans excel , j'ai également utilisé avec VB 6 do while (Not rs.EOF) pour des TABLES venant d ACCES avec une requête sql

Mais je n'arrive pas à faire la boucle sur plusieurs chaines
pour allez d'un TR à l'autre

ouverture du fichier

Data = ReadFile(App.Path & "\Y.html")

lecture du fichier cela fonctionne bien

Function ReadFile(ByVal FileName As String) As String



Dim Free As Integer
Free = FreeFile()
Open FileName For Binary As Free
ReadFile = String(LOF(1), "<TR>")


Get Free, , ReadFile



on reduit la chaine totale du premier TR AU DERNIER TR

ReadFile = Mid$(ReadFile, InStr(1, ReadFile, "<TR>"))

On enlève les "",
ReadFile = Replace(ReadFile, "", vbNullString)


' Do While BOUCLE à l autre TR ???????

passage fonction MyMid
ReadFile = MyMid(ReadFile, "<TR>", "<TR>")




' Loop

Close Free
End Function


'Récupérer une chaîne (inconnue) placée entre deux chaînes (connues)

Private Function MyMid(ByRef Data As String, sLeft As String, sRight As String, Optional Start As Long = 1) As String



Dim lPosL As Long, lPosR As Long




lPosL InStr(Start, Data, sLeft): lPosR InStr(lPosL + 1, Data, sRight)
If lPosL > 0 And lPosR > 0 Then
MyMid = Mid$(Data, lPosL + Len(sLeft), lPosR - lPosL - Len(sLeft))
Else
MyMid = vbNullString
End If

'MsgBox
End Function


je vois bien que cela fonctionne mais comment boucler sans utiliser la longueur de la chaine en chiffre comme je l'ai déjà vu sur une autre formule et que j'ai déjà placé dans les messages plus haut

help
Peux tu encore m'aider


merci
0
Réponse 23 / 27
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 47
19 juil. 2009 à 17:51
attend si tu modifies les fonctions qui marchent çà va pas aller !!!

j'veux bien t'aider etc..., si je te dis data = readfile(fichier) est ok et que 3 messages après tu modifies la fonction....

relis mes précédents messages, tu as tous les éléments en main

et pour une boucle, tape FOR dans l'ide puis presse [F1], l'aide (msdn locale) est faite pour être utilisée
0
Réponse 24 / 27
FOUNI Messages postés 28 Date d'inscription dimanche 8 juillet 2007 Statut Membre Dernière intervention 8 mars 2013
23 juil. 2009 à 01:08
BONJOUR,

voilà ce que j 'ai réusir à faire


le récupère colonne 0 de mon flexgrid la chaine totale deS ligneS du fichier html

puis je récupère les noms des personnes en colonne 1 et lactivité en colonne 2


par contre je n'arrive pas avec les couleurs , ni à récupérer la chaine quand elle est identique à la boucle précédente , je pense qu'il faut que je découpe la chaine en ligne et non en colonne comme le fait dans mon code


declaration
Public RR As Variant

Public TT As String

Public lig As String



Private Sub Command1_Click()
pour LIRE le fichier

Data = ReadFile(App.Path & "\Y.html")

End Sub





Function ReadFile(ByVal FileName As String) As String



Dim Start As Long, sRet As String
Start = 1


Dim Free As Integer
Free = FreeFile()
Open FileName For Binary As Free
ReadFile = String(LOF(1), 0)

Get Free, , ReadFile

ReadFile = Mid$(ReadFile, InStr(1, ReadFile, "<TR>"))
ReadFile = Replace(ReadFile, "", vbNullString)
'ReadFile Replace(ReadFile, "<TD BGCOLOR #C8C8C8 >", vbNullString)
TT = -1
BOUCLE POUR RECUPERER LES CHAINES

Do While Start

TT = TT + 1



sRet = MyMid(ReadFile, "<TR>", "</TR>", Start)


Me.MSFlexGrid.Col = 0
Me.MSFlexGrid.Row = TT

Me.MSFlexGrid.Text = lig


If Start = 0 Then GoTo FIN

sRet = MyMid(ReadFile, " ", " ", Start - 1)


Me.MSFlexGrid.Col = 1
Me.MSFlexGrid.Row = TT + 1

Me.MSFlexGrid.Text = lig


sRet MyMid(ReadFile, "</TD><TD BGCOLOR #", "</TD><TD", Start - 1)


Me.MSFlexGrid.Col = 2
Me.MSFlexGrid.Row = TT + 1

RR = Len(lig)
lig = Mid(lig, 10, RR)

Me.MSFlexGrid.Text = lig



sRet MyMid(ReadFile, "</TD><TD BGCOLOR #", "</TD><TD", Start - 1)


Me.MSFlexGrid.Col = 3
Me.MSFlexGrid.Row = TT + 1

RR = Len(lig)
lig = Mid(lig, 10, RR)

Me.MSFlexGrid.Text = lig


Loop


FIN:
Close Free


End Function

Private Function MyMid(ByRef sRet As String, sLeft As String, sRight As String, Optional Start As Long = 1) As String


Dim lPosL As Long, lPosR As Long




lPosL InStr(Start, sRet, sLeft): lPosR InStr(lPosL + 1, sRet, sRight)
If lPosL > 0 And lPosR > 0 Then
lig = Mid$(sRet, lPosL + Len(sLeft), lPosR - lPosL - Len(sLeft))





Start = lPosR + Len(sRight)



Else
lig = vbNullString
Start = 0

End If


End Function


besoin aide sur boucle


merci
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 25 / 27
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 47
23 juil. 2009 à 01:32
Get Free, , ReadFile

ReadFile = Mid$(ReadFile, InStr(1, ReadFile, "<TR>"))

voilà l'endroit où je me suis arrêté de lire ta réponse

je n'ai pas lu le reste parce que NON NON et NON


si tu fais TA procédure, OK

mais là de nouveau tu modifies un code valide pour en faire n'importe quoi

ton code doit être dans le command1, travaillant sur le contenu de DATA

tu n'as pas à toucher à readfile ni aux autres fonctions de liens que j'ai indiqué

j'insiste parce que c'est important!!
le "tout fait fonctionnel" uniquement est à utiliser, plus tard tu adapteras bien sûr, mais ne grillons pas les étapes.

fait ton code autour d'un noyau qui est opérationnel, donc les 3 liens avec mes explications pas à pas

sans quoi en tout cas, çà sera sans moi

bon courage
0
Réponse 26 / 27
FOUNI Messages postés 28 Date d'inscription dimanche 8 juillet 2007 Statut Membre Dernière intervention 8 mars 2013
23 juil. 2009 à 16:22
OK je pense que le code est bon , il fonctionne

reste à faire une boucle et à mettre les couleurs

je vois le principe mais il faut que je trouve où indiquer la fonction , mais avant je vais dormir

merci pour l'aide , par contre je ne suis pas contre le fait que tu me donne ton code ou que tu corriges le mien si possible pour voir la structure fait par un pro


j'espère pouvoir un jour "aider" à mon tour sans prétention

Public RRR As Variant

Public TT As String
Public TTT As Long
Public Start As Long, data As String







Private Sub Command1_Click()


data = ReadFile(App.Path & "\Y.html")


TT = MyMid(data, "<TR>", "</TR>", Start)
data = Replace(data, "", vbNullString)

RRR = 0
Start = 1
Do While Start

RRR = RRR + 1


TT = MyMid(data, " ", " ", Start)


Me.MSFlexGrid.Col = 0
Me.MSFlexGrid.Row = RRR

Me.MSFlexGrid.Text = TT


TT = MyMid(data, "<TD", "</TD>", Start)


TTT = Len(TT)
TT = Mid(TT, 23, TTT)



Me.MSFlexGrid.Col = 1
Me.MSFlexGrid.Row = RRR

Me.MSFlexGrid.Text = TT


TT = MyMid(data, ">", "</TD>", Start)

Me.MSFlexGrid.Col = 2
Me.MSFlexGrid.Row = RRR

Me.MSFlexGrid.Text = TT


TT = MyMid(data, ">", "</TD>", Start)


Me.MSFlexGrid.Col = 3
Me.MSFlexGrid.Row = RRR

Me.MSFlexGrid.Text = TT



TT = MyMid(data, ">", "</TD>", Start)


Me.MSFlexGrid.Col = 4
Me.MSFlexGrid.Row = RRR

Me.MSFlexGrid.Text = TT


TT = MyMid(data, ">", "</TD>", Start)


Me.MSFlexGrid.Col = 5
Me.MSFlexGrid.Row = RRR

Me.MSFlexGrid.Text = TT



TT = MyMid(data, ">", "</TD>", Start)


Me.MSFlexGrid.Col = 6
Me.MSFlexGrid.Row = RRR

Me.MSFlexGrid.Text = TT


TT = MyMid(data, ">", "</TD>", Start)


Me.MSFlexGrid.Col = 7
Me.MSFlexGrid.Row = RRR

Me.MSFlexGrid.Text = TT

TT = MyMid(data, ">", "</TD>", Start)


Me.MSFlexGrid.Col = 8
Me.MSFlexGrid.Row = RRR

Me.MSFlexGrid.Text = TT

TT = MyMid(data, ">", "</TD>", Start)


Me.MSFlexGrid.Col = 9
Me.MSFlexGrid.Row = RRR

Me.MSFlexGrid.Text = TT



Loop



End Sub




Function ReadFile(ByVal FileName As String) As String


Start = 1

Dim Free As Integer
Free = FreeFile()
Open FileName For Binary As Free
ReadFile = String(LOF(1), 0)
Get Free, , ReadFile




Close Free




End Function





Private Function MyMid(ByRef Expression As String, sLeft As String, sRight As String, Optional Start As Long = 1) As String
Dim lPosL As Long, lPosR As Long

If Start = 0 Then
Exit Function
End If

lPosL InStr(Start, Expression, sLeft): lPosR InStr(lPosL + 1, Expression, sRight)
If lPosL > 0 And lPosR > 0 Then
MyMid = Mid$(Expression, lPosL + Len(sLeft), lPosR - lPosL - Len(sLeft))


Start = lPosR + Len(sRight)



Else
MyMid = vbNullString
Start = 0

End If
End Function



'
'
Function GetOleColorFromHtmlColor(ByVal sCol As String) As OLE_COLOR
sCol = RightB$(sCol, LenB(sCol) - 2)
sCol = Right$(sCol, 2) & Mid$(sCol, 3, 2) & Left$(sCol, 2)
GetOleColorFromHtmlColor = CLng("&H00" & sCol)
End Function



BONNE JOURNEE ET MERCI MERCI
0
Réponse 27 / 27
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 47
23 juil. 2009 à 17:17
Public RRR As Variant
-> pourquoi public? pourquoi variant ?


[i]Public TT As String
Public TTT As Long /i
-> bel effort sur les noms... un plaisir à relire


[i]TT = MyMid(data, "<TR>", "</TR>", Start)
data = Replace(data, "", vbNullString) /i
-> pourquoi sur DATA si tu travailles sur TT


Do While Start
-> et start change quand?


TT = MyMid(data, " ", " ", Start)
-> alors pourquoi avoir récupéré avant?


TT = Mid(TT, 23, TTT)
-> d'où sort 23? rien de générique là!


[i]TT = MyMid(data, ">", "</TD>", Start)
Me.MSFlexGrid.Col = 4
Me.MSFlexGrid.Row = RRR
Me.MSFlexGrid.Text = TT
TT = MyMid(data, ">", "</TD>", Start)

Me.MSFlexGrid.Col = 5
Me.MSFlexGrid.Row = RRR
Me.MSFlexGrid.Text = TT
(...)/i
-> en effet j'ai parlé de boucle, mais tel quel tu ne pourras pas


merci pour l'aide , par contre je ne suis pas contre le fait que tu me donne ton code ou que tu corriges le mien si possible pour voir la structure fait par un pro
-> par un pro je ne sais pas, mais çà sellera le sujet en effet (au bout de 10 jours ^^) 



Option Explicit

Private Sub Form_Load()
    Dim sFile   As String
    Dim sBuffer As String
    Dim sText   As String
    Dim asCol() As String
    Dim sColor  As String
    Dim i       As Integer
    Dim j       As Integer
    
    
'   récupération contenu du html
    sFile  = ReadFile(App.Path & "\Y.html")

'   cherche les 1er TR et supprime ce qu'il y a avant
    sFile = Mid$(sFile, InStr(1, sFile, "<TR>"))

'   supprime toutes les  qui ne servent à rien et qui ne sont même pas fermées
    sFile = Replace(sFile, "", vbNullString)
    
'   on récupère tous les tronçons TR, en boucle, toujours en supprimant le texte récupéré
    i = 0
    Do While InStr(1, sFile, "<TR>" & vbCrLf)
        sBuffer = MyMid(sFile, "<TR>" & vbCrLf, "</TR>")
        'Debug.Print "&#164;" & sBuffer & "&#164;"
        sFile = Mid$(sFile, InStr(1, sFile, "<TR>") + 1 + Len(sBuffer))
        i = i + 1
'       i=1 => header. sinon champs
        If i = 1 Then
'           supprime les  et récupère toutes les colonnes
            sBuffer = Replace(sBuffer, "", vbNullString)
            sBuffer = Replace(sBuffer, "", vbNullString)
            asCol = Split(sBuffer, "/TD>")
            
            For j = 0 To UBound(asCol) - 1
'               nouvelle colonne
                sColor = MyMid(asCol(j), "#", " ")
                sText = MyMid(asCol(j), ">", "<")
                
                With MSFlexGrid1
                    .Rows = 1
                    .Cols = j + 1
                    .ColWidth(j) = 2000
                    .Row = 0
                    .Col = j
                    .Text = sText
                    .CellFontBold = True
                    .CellBackColor = GetOleColorFromHtmlColor("#" & sColor)
                End With
            Next j
        Else
            asCol = Split(sBuffer, "/TD>")
'           colonne de gauche
            sColor = MyMid(asCol(0), "#", " ")
            sText = MyMid(asCol(0), " ", " ")
            
            With MSFlexGrid1
                .Rows  = .Rows + 1
                .Row = .Rows - 1
                .Col = 0
                .Text = sText
                .CellFontBold = True
                .CellBackColor = GetOleColorFromHtmlColor("#" & sColor)
                
'               texte des autres cellules
                For j = 1 To UBound(asCol) - 1
                    sColor = MyMid(asCol(j), "#", " ")
                    sText = MyMid(asCol(j), ">", "<")
                    .Col = .Col + 1
                    .Text = sText
                    .CellBackColor = GetOleColorFromHtmlColor("#" & sColor)
                Next j
            End With
        End If
    Loop
End Sub



'----------------------------------------------------------------
'    LIRE LA TOTALITÉ DU CONTENU D'UN FICHIER
'    http://www.codyx.org/snippet_lire-totalite-contenu-fichier_47.aspx#133
'----------------------------------------------------------------
Private Function ReadFile(ByVal FileName As String) As String
    Dim Free As Integer
    Free = FreeFile()
    Open FileName For Binary As Free
    ReadFile = String(LOF(1), 0)
    Get Free, , ReadFile
    Close Free
End Function
'----------------------------------------------------------------



'----------------------------------------------------------------
'    RÉCUPÉRER UNE CHAÎNE (INCONNUE) PLACÉE ENTRE DEUX CHAÎNES (CONNUES)
'    http://www.codyx.org/snippet_recuperer-chaine-inconnue-placee-entre-deux-chaines-connues_334.aspx#1043
'----------------------------------------------------------------
Private Function MyMid(ByRef Expression As String, sLeft As String, sRight As String, Optional Start As Long = 1) As String
    Dim lPosL As Long, lPosR As Long
    lPosL InStr(Start, Expression, sLeft): lPosR InStr(lPosL + 1, Expression, sRight)
    If lPosL > 0 And lPosR > 0 Then
        MyMid = Mid$(Expression, lPosL + Len(sLeft), lPosR - lPosL - Len(sLeft))
    Else
        MyMid = vbNullString
    End If
End Function
'----------------------------------------------------------------



'----------------------------------------------------------------
'    CONVERTIR UNE COULEUR LONG EN CODE HTML (ET VICE VERSA)
'    http://www.codyx.org/snippet_convertir-couleur-long-code-html-vice-versa_254.aspx#818
'----------------------------------------------------------------
Private Function GetOleColorFromHtmlColor(ByVal sCol As String) As OLE_COLOR
    sCol = RightB$(sCol, LenB(sCol) - 2)
    sCol = Right$(sCol, 2) & Mid$(sCol, 3, 2) & Left$(sCol, 2)
    GetOleColorFromHtmlColor = CLng("&H00" & sCol)
End Function
'----------------------------------------------------------------



bon lecture
0

Discussions similaires

exemple de page d'accueil avec la balise div et css
belkaiednaim -
belkaiednaim -

5 réponses
code source HTML
bandifull -
bandifull -

5 réponses
Interface pour chaque page
Xini28 -
malalam -

4 réponses
PAGE D'ACCUEIL EN VB.NET
Kentobar -
Kentobar -

2 réponses
Afficher le code source d'une page HTML
bullow -
Marcial -

3 réponses
Rejoignez-nous