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 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
|
NbDates = InputBox("Nombre de dates ?", "Extraction")
chemin= "Extract.XLS"
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fic = fso.CreateTextFile(chemin, True)
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
IE.Silent = True
URL = "http://www.ff-handball.org/competitions/championnats-departementaux/44-comite-de-la-loire-atlantique.html?tx_obladygesthand_pi1%5Bsaison_id%5D=9&tx_obladygesthand_pi1%5Bcompetition_id%5D=19723&tx_obladygesthand_pi1%5Bphase_id%5D=48413&tx_obladygesthand_pi1%5Bgroupe_id%5D=68434&tx_obladygesthand_pi1%5Bmode%5D=single_phase&cHash=8ccfe7eacbe5ed942db622aeb88158a4"
IE.Navigate URL
Do While IE.Busy
WScript.Sleep(100)
Loop 'attend la fin du chargement
WScript.Sleep(1500)
Contenu = uCase(IE.Document.DocumentElement.innerHTML)
Continuer = true
' Titres des colonnes
' chr (34) remplace les guillements à la suite de l'instruction
Fic.writeLine "ID;PWXL;N;E" ' Début du codage excel
Fic.writeLine "C;Y1;X1;K" & CHR(34) & ("Journée") & CHR(34)
Fic.writeLine "C;Y1;X2;K" & CHR(34) & ("Date") & CHR(34)
Fic.writeLine "C;Y1;X3;K" & CHR(34) & ("Heure") & CHR(34)
Fic.writeLine "C;Y1;X4;K" & CHR(34) & ("Domicile") & CHR(34)
Fic.writeLine "C;Y1;X5;K" & CHR(34) & ("Visiteur") & CHR(34)
Fic.writeLine "C;Y1;X6;K" & CHR(34) & ("Adresse") & CHR(34)
Ligne = 2
do while Continuer = true
' Chercher le mot titrejour et ajouter les 5 caractères du mot titrejour>
Pos = InStr(Contenu, "TITREJOUR") + 10
if Pos = 0 then
Continuer = false
exit do
end if
' Ne conserver le texte qu'à partir de la 1ère journée
Contenu = Mid(Contenu, Pos)
' Chercher la fin de titrejour
Pos = InStr(Contenu, "</P>") - 1
if Pos = 0 then
Continuer = false
exit do
end if
' La journée
Str_Journee = mid(Contenu, 1, Pos)
for i = 1 to cInt(NbDates)
' Chercher le mot date et ajouter les 5 caractères du mot date>
Pos = InStr(Contenu, "DATE") + 5
if Pos = 0 then
Continuer = false
exit for
end if
' Ne conserver le texte qu'à partir de la 1ère date
Contenu = Mid(Contenu, Pos)
' La date sur 10 caractères => jj/mm/aaa
Str_Date = Mid(Contenu, 1, 10)
' On passe les 10 caractères de la date et la chaine <br> + 1
Contenu = Mid(Contenu, 15)
' L'heure sur 8 caractères => hh:mm:ss
Str_Heure = Mid(Contenu, 1, 8)
' Chercher la chaine <STRONG>
Pos = InStr(Contenu, "<STRONG>")
if Pos = 0 then
Continuer = false
exit for
end if
' Ne conserver le texte qu'à partir de la 1ère valeur domicile
Contenu = Mid(Contenu, Pos)
' Chercher la chaine </P>
Pos = InStr(Contenu, "</P>") - 1
if Pos = 0 then
Continuer = false
exit for
end if
' Le domicile moins la chaine </STRONG>
Str_Domicile = Replace(Mid(Contenu, 1, Pos), "</STRONG>", "")
Str_Domicile = Replace(Str_Domicile, "<STRONG>", "")
Contenu = Mid(Contenu, Pos)
' Chercher la chaine <STRONG>
Pos = InStr(Contenu, "<STRONG>")
if Pos = 0 then
Continuer = false
exit for
end if
' Chercher la chaine </STRONG>
Pos = InStr(Contenu, "<STRONG>")
if Pos = 0 then
Continuer = false
exit for
end if
Contenu = Mid(Contenu, Pos)
' Chercher la chaine </P>
Pos = InStr(Contenu, "</P>") - 1
if Pos = 0 then
Continuer = false
exit for
end if
' Le visiteur moins la chaine </STRONG></STRONG>
Str_Visiteur = Replace(Mid(Contenu, 1, Pos), "</STRONG>", "")
Str_Visiteur = Replace(Str_Visiteur, "</STRONG>", "")
Str_Visiteur = Replace(Str_Visiteur, "<STRONG>", "")
' Chercher la 1ère chaine data-text-tooltip
Pos = InStr(Contenu, "DATA-TEXT-TOOLTIP") + 19
if Pos = 0 then
Continuer = false
exit for
end if
Contenu = Mid(Contenu, Pos)
' Chercher la 2ème chaine data-text-tooltip
Pos = InStr(Contenu, "DATA-TEXT-TOOLTIP") + 19
if Pos = 0 then
Continuer = false
exit for
end if
Contenu = Mid(Contenu, Pos)
' Chercher la 2ème chaine data-style-tooltip
Pos = InStr(Contenu, "DATA-STYLE-TOOLTIP") - 3
if Pos = 0 then
Continuer = false
exit for
end if
' L'adresse moins la chaine #/#
Str_Adresse = Replace(Mid(contenu, 1, Pos), "#/#", " ")
Fic.writeLine "C;Y" & Ligne & ";X1;K" & CHR(34) & (Str_Journee) & CHR(34)
Fic.writeLine "C;Y" & Ligne & ";X2;K" & CHR(34) & (Str_Date) & CHR(34)
Fic.writeLine "C;Y" & Ligne & ";X3;K" & CHR(34) & (Str_Heure) & CHR(34)
Fic.writeLine "C;Y" & Ligne & ";X4;K" & CHR(34) & (Str_Domicile) & CHR(34)
Fic.writeLine "C;Y" & Ligne & ";X5;K" & CHR(34) & (Str_Visiteur) & CHR(34)
Fic.writeLine "C;Y" & Ligne & ";X6;K" & CHR(34) & (Str_Adresse) & CHR(34)
Ligne = Ligne + 1
Next
Loop
IE.Quit
Set IE = Nothing
Fic.writeLine "E" ' Fin du codage excel
Fic.Close
Set Fic = Nothing
Set fso = Nothing
msgbox "Terminé." |
Partager