PROGRAMME TV : COLLECTE DES INFOS SUR SITE WEB (REQUETE WEB DANS EXCEL)

---

Commentaire sur cette source (13)
Ajouter un commentaire et/ou une note

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.

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

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

• AUTOMATISATION EXÉCUTION CRYSTAL REPORT AVEC PASSAGE DE PARAMÈTRES
• RGB COULEURS
• LISTE DES FICHIERS D'UN RÉPERTOIRE AU FORMAT HTML

• INTERCEPTER DES APPELS DE METHODE (SURCHARGE DE VTABLE)
• CYBER COUNTER V2
• OUVRIR DES DOCUMENTS DANS LA MÊME INSTANCE DE L'APPLICATION SANS RELANCEMENT DE L'EXE (DDE) EN .NET
• CONTRÔLE PCANYWHERE
• LIEN DDE EN VB2005