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
| Option Explicit
Sub extractionDonneesPageHtml()
'necessite d'activer la reference Microsoft Internet Controls
Dim IE As InternetExplorer
Dim nFile As Integer
Dim infosLigne As String
Dim i As Byte
Dim Lig As Boolean
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = False
.Silent = True
.Navigate "http://www.allocine.fr/series/episodes_gen_csaison=118&cserie=55.html"
Do Until .ReadyState = READYSTATE_COMPLETE
DoEvents
Loop 'attend la fin du chargement
nFile = FreeFile
Open "C:\test.txt" For Output Shared As #nFile
Print #nFile, .Document.DocumentElement.InnerText
Close #nFile
.Quit
End With
Set IE = Nothing
Lig = False
Open "C:\test.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, infosLigne
If Left(infosLigne, 7) = "Episode" Then
i = i + 1
Cells(i, 1) = Mid(infosLigne, InStr(1, infosLigne, "-") + 2, _
Len(infosLigne) - InStr(1, infosLigne, "-"))
End If
If Lig = True Then
Cells(i, 6) = infosLigne
Lig = False
End If
If Left(infosLigne, 14) = "Titre original" Then
Cells(i, 2) = Mid(infosLigne, InStr(1, infosLigne, ":") + 2, _
Len(infosLigne) - InStr(1, infosLigne, ":"))
Lig = True
End If
If Left(infosLigne, 11) = "Réalisé par" Then _
Cells(i, 3) = Mid(infosLigne, InStr(1, infosLigne, ":") + 2, _
Len(infosLigne) - InStr(1, infosLigne, "-"))
If Left(infosLigne, 9) = "Ecrit par" Then _
Cells(i, 4) = Mid(infosLigne, InStr(1, infosLigne, ":") + 2, _
Len(infosLigne) - InStr(1, infosLigne, ":"))
If Left(infosLigne, 19) = "Acteurs secondaires" Then _
Cells(i, 5) = Mid(infosLigne, InStr(1, infosLigne, ":") + 2, _
Len(infosLigne) - InStr(1, infosLigne, ":"))
Loop
Close #1
Kill "C:\test.txt"
End Sub |