Programme tv : collecte des infos sur site web (requete web dans excel)

Télécharger le projet
Commenter

Description

Petit programme qui va collecter sur un site web (www.tsr.ch = télévision suisse romande) les infos suivant le jour et la chaîne TV demandés + Envoi des données dans Excel grâce à une requête Web.

A l'ouverture du programme, il suffit de sélectionner le jour et la chaîne, et de cliquer sur le logo de la chaîne. Cela lance une requête web via Excel (vérifier la connexion). Le résultat s'affiche ensuite à l'écran...

REM : Pour l'instant ne retourne que l'horaire et le titre de l'émission principale du soir. Mais modification du code possible pour retourner plus d'infos.

Source / Exemple : 


Private Sub collecterInfos()

Dim xlApp As Excel.Application
Dim xlClasseur As Excel._Workbook
Dim xlFeuill As Excel._Worksheet
Dim siteWeb As String
Dim chaine As Integer
Dim myProcesses() As Process
Dim myProcess As Process

' Modification de la chaine dans le cas où l'index de la combo est supérieur à 2
' Car sur le site d'où proviennent mes infos les index sont incrémentés 1, 2, 10, 11, 12, 13,... (saut de 2 à 10)
If cboChaine.SelectedIndex > 2 Then
   chaine = cboChaine.SelectedIndex + 8
Else
   chaine = cboChaine.SelectedIndex + 1
End If

' Construction de l'URL
' REM : recherche des infos sur le site de la TSR
siteWeb = "http://www.tsr.ch/tsr/index.html?siteSect=601000&idChaine=" & chaine & "&jourD=" & cboJour.Text & "&Ftime=1"

' Nouvelle application  Excel
xlApp = New Excel.Application
' Reste invisible
xlApp.Visible = False
' Ajout d'un onglet
xlClasseur = xlApp.Workbooks.Add

Dim xlFeuilles As Excel.Sheets = xlClasseur.Sheets
xlFeuill = xlFeuilles(1)

' Vide la feuille de son contenu
With xlFeuill
   .Cells.ClearContents()
End With

' Macro qui va rechercher les infos sur le site Web
With xlFeuill.QueryTables.Add("URL;" & siteWeb & "", xlFeuill.Range("A1"))
   .Name = "index.html?siteSect=601000&jourD=" & cboJour.Text & "&Ftime=1&idChaine=" & chaine & ""
   .FieldNames = True
   .RowNumbers = False
   .FillAdjacentFormulas = False
   .PreserveFormatting = True
   .RefreshOnFileOpen = False
   .BackgroundQuery = True
   .RefreshStyle = Excel.XlCellInsertionMode.xlInsertDeleteCells
   .SavePassword = True
   .SaveData = True
   .AdjustColumnWidth = True
   .RefreshPeriod = 0
   .WebSelectionType = Excel.XlWebSelectionType.xlSpecifiedTables
   .WebFormatting = Excel.XlWebFormatting.xlWebFormattingNone
   .WebTables = "39"
   .WebPreFormattedTextToColumns = True
   .WebConsecutiveDelimitersAsOne = True
   .WebSingleBlockTextImport = False
   .WebDisableDateRecognition = False
   .WebDisableRedirections = False
   .Refresh(BackgroundQuery:=False)
End With

' Sélection des cellules dont on a besoin
txtHoraire.Text = xlFeuill.Range("B3").Text
txtTitre.Text = xlFeuill.Range("C3").Text
txtRemarque.Text = xlFeuill.Range("B5").Text

' Fermeture de l'application sans sauvegarde
xlClasseur.Close(False)
xlApp.Quit()

' Contrôle des process
' Si un process EXCEL tourne encore je le flingue...
myProcesses = Process.GetProcesses()

For Each myProcess In myProcesses
   If UCase(myProcess.ProcessName) = "EXCEL" Then
      myProcess.Kill()
   End If
Next

End Sub
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (berocca)