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

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 zip