Taille du fichier en exponentiel suite requete puis optimisation

**patricktoulon** · 06/10/2015, 10h30

c'est quoi le message d'erreur

**Sebphyto** · 06/10/2015, 10h42

Pardon oui,
Nom : Capture.PNG
Affichages : 194
Taille : 4,5 Ko

**patricktoulon** · 06/10/2015, 11h07

tiens prends celui la
j'ai tout formaté a 15 chevaux

**Sebphyto** · 06/10/2015, 11h15

Niquel mon petit monsieur...

Tu m'as devancé, je suis un peu long, mais j'étais sur le point de te dire que l'erreur venait de cela...si j'avais bien compris...

Seb

**patricktoulon** · 06/10/2015, 11h24

non ca ne venait pas de la
c'est simplement un probleme de temps entre les fonction s

**Sebphyto** · 06/10/2015, 11h26

Ok, bon j'ai encore des choses à voir alors....je persévère
merci de ton soutien
seb

**patricktoulon** · 10/10/2015, 11h44

Bonjour sebphyto
voila la nouvelle version avec l'archivage et MFC

attention il arrive qu'il ne donne pas l'arrivée et donc la mfc ne se fait pas
je cherche un site simple qui me la donnerait par une requete rapide en attendant prend ce bébé

**Sebphyto** · 10/10/2015, 11h45

Salut Patrick,

Je teste et je reviens

**Sebphyto** · 10/10/2015, 11h50

Re,

C bon pour moi, récupe arrivée d'hier et prono d'aujourd'hui.....c good

Pourquoi ne récupère-tu pas l'arrivée avec zeturf en même temps que les rapports?

Seb

**patricktoulon** · 10/10/2015, 12h13

déidément a chaqune de tes absences quand tu reviens tu a tout oublié

le principe est l'automatisation

la mfc dans le nouveau model se fait directement l'ors de l'archivage il va faloiur encore que je separe cela

purrée
comment tu a récupéré l'arrivée d'hiers toi ? par sur presse ? tu n'a donc pas la MFC qui s'est effectuée LOL

l'archivage est correct chez toi?

**Sebphyto** · 10/10/2015, 13h06

Re,

En appuyant sur le bouton de la page archivage voici ce que j'obtiens

Nom : Capture.PNG
Affichages : 219
Taille : 32,9 Ko

**patricktoulon** · 10/10/2015, 15h16

oui visiblement il y a des heures a la quelle il faut pas se connecter depuis ce matin sur la page il y avait pas l'arrivée

j'essaierai tout a l'heure en rentrant

**patricktoulon** · 10/10/2015, 16h38

bon je viens de rentrer et je viens de voir qu'il vienne de modifier meme la page mobile de la meme maniere que la presse fg

il ny a plus toutes les tables dans la page mobile
il faut appuyer sur un bouton plusieur fois pour toutes les capturer

bon il faut tout recommencer

j'avoue que ca commence a me gonfler menu
Nom : Capture.JPG
Affichages : 217
Taille : 97,2 Ko

Nom : Capture.JPG
Affichages : 217
Taille : 97,2 Ko

**Sebphyto** · 11/10/2015, 11h49

Salut patrick,

C une histoire sans fin, comme de faite cela ne fonctionne déjà plus, ils sont casse-noix, bref si cela te gave tu peux arrêter, je ne t'en voudrai pas

**patricktoulon** · 11/10/2015, 12h41

j'ai deja rebondi moi LOL LOl

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Sub test2()
    Dim Ie1, url(4)
    url(1) = "http://www.pronostics-turf.info/presse-mobile.php"
    Set dico = CreateObject("Scripting.Dictionary")
    Set Ie1 = CreateObject("internetexplorer.application")
    Ie1.Visible = True
    Ie1.navigate url(1)
    Do: DoEvents: Loop While Ie1.readystate = False Or Ie1.busy
    codehtml = Ie1.document.body.innerhtml
    oldloc = Ie1.locationurl
    'lscript = Split(codehtml, "<script>")
    'codehtml = Replace(codehtml, Split(lscript(3), "</script>")(0), "")
    Set fauxdoc = CreateObject("htmlfile")
    For p = 1 To 2
        With fauxdoc
            .write codehtml
            Set mestables = .getelementsbytagname("TABLE")
            For i = 0 To mestables.Length - 1
                If Not dico.exists(mestables(i).innertext) Then
                    dico(mestables(i).innertext) = ""
                    If mestables(i).getelementsbytagname("TR").Length = 1 Then
                        codi = codi & vbCrLf & mestables(i).getelementsbytagname("TR")(0).outerhtml
                    Else
                        codi = codi & vbCrLf & "<TR><TH> Nombres de fois cités:</TH>" & mestables(i).getelementsbytagname("TR")(1).innerhtml & "</TR>" & vbCrLf
                        codi = codi & vbCrLf & "<TR><TH> Syntheze par Points::</TH>" & mestables(i).getelementsbytagname("TR")(4).innerhtml & "</TR>" & vbCrLf
                    End If
                End If
            Next
        End With
        For Each elem In Ie1.document.all
            pge = Array("href=""suite")
            For btp = LBound(pge) To UBound(pge)
                If elem.tagname = "A" And elem.outerhtml Like "*" & "href=""presse-mobile-suite.php" & "*" Then elem.Click: Exit For
            Next
        Next
        Do: DoEvents: Loop While Ie1.readystate = False Or Ie1.busy
        codehtml = Ie1.document.body.innerhtml
    Next
    Ie1.Quit
    With fauxdoc
        .write "<table>" & codi & "</table>"
        For Each elem In .all
            If elem.tagname = "IMG" Then codi = Replace(codi, elem.outerhtml, "")
            If elem.tagname = "TH" Or elem.tagname = "TD" Then codi = Replace(codi, elem.outerhtml, "<TH>" & Trim(elem.innertext) & "</TH>")
        Next
        .body.innerhtml = "<table>" & codi & "</table>"
        Debug.Print .body.innerhtml
        If .parentWindow.clipboardData.setData("Text", .body.innerhtml) Then
            Application.ScreenUpdating = False
            With Sheets(1)
                .Activate
                .Cells.Clear
                .Columns("A:A").ColumnWidth = 25
                .Columns("B:R").ColumnWidth = 10
                Cells(2, 1).Select
                .Paste
            End With
            .parentWindow.clipboardData.clearData "Text"
        End If
    End With
End Sub