Option Explicit
Sub ParVentEtMaré()
Dim city, url As String, VILLES() As ville, conn As Object
' Créer une connexion ADODB
Set conn = CreateADODBConnection(ThisWorkbook.FullName)
For Each city In RetournVille(conn)
' Construire l'URL de la page web
url = "https://horaire-maree.fr/maree/" & city & "/"
If CheckURL(url, CStr(city)) And city <> "" Then
RetorunVilleMatin CStr(city), VILLES, Now, GetHTMLDocument(url)
RetorunVilleAprès CStr(city), Now, VILLES
' Insérer les données de marées
ProcessAndInsertTideData conn, VILLES
End If
Next
' Fermer la connexion ADODB
conn.Close
Set conn = Nothing
End Sub
Sub RetorunVilleMatin(v As String, TbVille() As ville, D As String, htmlDoc As Object)
Dim NB As Integer, Champ As Integer, tb, tb2, i As Integer, T, A
tb = Split(htmlDoc.getElementById("i_donnesJour").getElementsByTagName("table")(0).innerhtml, "<TD class=""blueoffice whitetxt"">")
For i = 1 To UBound(tb)
ReDim Preserve TbVille(NB)
If TypeName(TbVille(NB)) = "Nothing" Then Set TbVille(NB) = New ville
TbVille(NB).ville = v: TbVille(NB).MyDate = Format(D, "yyyy-mm-dd")
tb2 = Split(tb(i), "<STRONG>")
For Each T In tb2
Debug.Print T
A = Split(Replace(Replace(Replace(Replace(T, "</STRONG>", ""), "<BR>", ";"), "<TD>", ""), "</TD>", "") & ";", ";")
Select Case Champ
Case 1: If A(0) <> "" Then TbVille(NB).Matin_Coeff = CStr(A(0))
Case 2: If A(0) <> "" Then TbVille(NB).Matin_Basse_mere = CDate(Replace(A(0), "h", ":")): TbVille(NB).Matin_Basse_mere_Niveau_Zéro = Val(Replace(A(1), ",", "."))
Case 3: If A(0) <> "" Then TbVille(NB).Matin_Pleine_mere = CDate(Replace(A(0), "h", ":")): TbVille(NB).Matin_Pleine_mere_Niveau_Zéro = Val(Replace(A(1), ",", "."))
Case 4: If A(0) <> "" Then TbVille(NB).Après_midi_Coeff = CStr(A(0))
Case 5: If A(0) <> "" Then TbVille(NB).Après_midi_Basse_mere = CDate(Replace(A(0), "h", ":")): TbVille(NB).Après_midi_Basse_mere_Niveau_Zéro = Val(Replace(A(1), ",", "."))
Case 6: If A(0) <> "" Then TbVille(NB).Après_midi_Pleine_mere = CDate(Replace(A(0), "h", ":")): TbVille(NB).Après_midi_Pleine_mere_Niveau_Zéro = Val(Replace(A(1), ",", "."))
End Select
Champ = Champ + 1
Next
Next
End Sub
Function RetournVille(Cn As Object) As String()
With Cn.Execute("Select * from[VILLES$]")
If .EOF Then RetournVille = Array("")
RetournVille = Split(.getstring, vbCr)
End With
End Function
'Sub RetorunVilleAprès(city As String, D As String, VS() As ville)
'Dim tideTable As Object, htmlDoc As Object
' ' Récupérer le document HTML
' Set htmlDoc = GetHTMLDocument("https://horaire-maree.fr/maree/" & city & "/")
'
' ' Trouver la table de marées par ID
' Set tideTable = htmlDoc.getElementById("i_donnesLongue").getElementsByTagName("table")(0)
'
' ' Extraire les données de marées
' Set tideData = ExtractTideData(tideTable)
' For i = 1 To tideData.count
' ReDim Preserve VS(i)
'
' If TypeName(VS(i)) = "Nothing" Then Set VS(i) = New ville
' VS(i).ville = city
' VS(i).MyDate = Format((CDate(D) + i), "yyyy-mm-dd")
'
' If Trim("" & tideData(i)(2)) <> "" Then VS(i).Matin_Coeff = tideData(i)(2)
' If Trim("" & tideData(i)(3)) <> "" Then
' VS(i).Matin_Basse_mere = Replace(Left(tideData(i)(3), 5), "h", ":")
' VS(i).Matin_Basse_mere_Niveau_Zéro = Val(Replace(Split(tideData(i)(3), Left(tideData(i)(3), 5))(1), ",", "."))
' End If
' If Trim("" & tideData(i)(4)) <> "" Then
' VS(i).Matin_Pleine_mere = Replace(Left(tideData(i)(4), 5), "h", ":")
' VS(i).Matin_Basse_mere_Niveau_Zéro = Val(Replace(Split(tideData(i)(4), Left(tideData(i)(4), 5))(1), ",", "."))
' End If
' If Trim("" & tideData(i)(5)) <> "" Then VS(i).Après_midi_Coeff = tideData(i)(5)
' If Trim("" & tideData(i)(6)) <> "" Then
' VS(i).Après_midi_Basse_mere = Replace(Left(tideData(i)(6), 5), "h", ":")
' VS(i).Après_midi_Basse_mere_Niveau_Zéro = Val(Replace(Split(tideData(i)(6), Left(tideData(i)(6), 5))(1), ",", "."))
' End If
' If Trim("" & tideData(i)(7)) <> "" Then
' VS(i).Après_midi_Pleine_mere = Replace(Left(tideData(i)(7), 5), "h", ":")
' VS(i).Après_midi_Pleine_mere_Niveau_Zéro = Val(Replace(Split(tideData(i)(7), Left(tideData(i)(7), 5))(1), ",", "."))
' End If
'
' Next
'
'End Sub
Sub RetorunVilleAprès(city As String, D As String, VS() As ville)
Dim tideTable As Object, htmlDoc As Object, rows As Object
Dim i As Integer
' Récupérer le document HTML
Set htmlDoc = GetHTMLDocument("https://horaire-maree.fr/maree/" & city & "/")
' Trouver la table de marées par ID
Set tideTable = htmlDoc.getElementById("i_donnesLongue").getElementsByTagName("table")(0)
Set rows = tideTable.getElementsByTagName("tr")
' Boucle pour parcourir toutes les lignes de données (ignorer les premières lignes de titres)
For i = 1 To rows.Length - 2
ReDim Preserve VS(i) ' Utilisation de i directement
If TypeName(VS(i)) = "Nothing" Then Set VS(i) = New ville
' Extraire les cellules de chaque ligne
Dim cells As Object
Set cells = rows(i + 1).getElementsByTagName("td") ' i+1 pour ignorer la première ligne de titres
' Assurez-vous que la ligne contient des données (c'est-à-dire qu'elle a le bon nombre de colonnes)
If cells.Length = 7 Then
VS(i).ville = city
VS(i).MyDate = Format((CDate(D) + i), "yyyy-mm-dd")
If Trim("" & cells(1).innerText) <> "" Then VS(i).Matin_Coeff = cells(1).innerText
If Trim("" & cells(2).innerText) <> "" Then
VS(i).Matin_Basse_mere = Replace(Left(cells(2).innerText, 5), "h", ":")
VS(i).Matin_Basse_mere_Niveau_Zéro = Val(Replace(Split(cells(2).innerText, Left(cells(2).innerText, 5))(1), ",", "."))
End If
If Trim("" & cells(3).innerText) <> "" Then
VS(i).Matin_Pleine_mere = Replace(Left(cells(3).innerText, 5), "h", ":")
VS(i).Matin_Pleine_mere_Niveau_Zéro = Val(Replace(Split(cells(3).innerText, Left(cells(3).innerText, 5))(1), ",", "."))
End If
If Trim("" & cells(4).innerText) <> "" Then VS(i).Après_midi_Coeff = cells(4).innerText
If Trim("" & cells(5).innerText) <> "" Then
VS(i).Après_midi_Basse_mere = Replace(Left(cells(5).innerText, 5), "h", ":")
VS(i).Après_midi_Basse_mere_Niveau_Zéro = Val(Replace(Split(cells(5).innerText, Left(cells(5).innerText, 5))(1), ",", "."))
End If
If Trim("" & cells(6).innerText) <> "" Then
VS(i).Après_midi_Pleine_mere = Replace(Left(cells(6).innerText, 5), "h", ":")
VS(i).Après_midi_Pleine_mere_Niveau_Zéro = Val(Replace(Split(cells(6).innerText, Left(cells(6).innerText, 5))(1), ",", "."))
End If
End If
Next i
End Sub
Sub ProcessAndInsertTideData(conn As Object, VILLES() As ville)
Dim v As Integer
Dim sql As String
Dim Rs As Object
Dim item As Variant
For v = 0 To UBound(VILLES)
' Construire la requête SQL de sélection
sql = "SELECT * FROM [Marées$] WHERE [Date]=#" & VILLES(v).MyDate & "# AND [Ville]='" & Replace(VILLES(v).ville, "'", "''") & "'"
' Créer un objet Recordset
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open sql, conn, 1, 3
If Rs.EOF Then Rs.AddNew ' Insérer une nouvelle ligne si la date et la ville n'existent pas
If VILLES(v).ville <> "" Then Rs.Fields("Ville").Value = VILLES(v).ville
If VILLES(v).MyDate <> "" Then Rs.Fields("Date").Value = VILLES(v).MyDate
Rs.Fields("Matin Coeff").Value = VILLES(v).Matin_Coeff
If VILLES(v).Matin_Basse_mere <> "" Then Rs.Fields("Matin Basse mer").Value = VILLES(v).Matin_Basse_mere
Rs.Fields("Matin Basse mer Niveau Zéro").Value = VILLES(v).Matin_Basse_mere_Niveau_Zéro
If VILLES(v).Matin_Pleine_mere <> "" Then Rs.Fields("Matin Pleine mer").Value = VILLES(v).Matin_Pleine_mere
Rs.Fields("Matin Pleine mer Niveau Zéro").Value = VILLES(v).Matin_Pleine_mere_Niveau_Zéro
Rs.Fields("Après-midi Coeff").Value = VILLES(v).Après_midi_Coeff
If VILLES(v).Après_midi_Basse_mere <> "" Then Rs.Fields("Après-midi Basse mer").Value = VILLES(v).Après_midi_Basse_mere
Rs.Fields("Après-midi Basse mer Niveau Zéro").Value = VILLES(v).Après_midi_Basse_mere_Niveau_Zéro
If VILLES(v).Après_midi_Pleine_mere <> "" Then Rs.Fields("Après-midi Pleine mer").Value = VILLES(v).Après_midi_Pleine_mere
Rs.Fields("Après-midi Basse mer Niveau Zéro") = VILLES(v).Après_midi_Pleine_mere_Niveau_Zéro
Rs.Update
Next
End Sub
Function CheckURL(url As String, ville As String) As Boolean
Dim http As Object
Dim statusCode As Integer
Dim responseText As String
' Créer un objet ServerXMLHTTP
Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
' Envoyer une requête GET
On Error GoTo Fin
http.Open "GET", url, False
http.setRequestHeader "User-Agent", "Mozilla/5.0" ' Ajouter un User-Agent
http.send
' Obtenir le code de statut HTTP
' Obtenir le texte de la réponse
responseText = LCase(http.responseText)
CheckURL = InStr(responseText, LCase(ville))
Fin:
Err.Clear
On Error GoTo 0
End Function
Function CreateADODBConnection(workbookPath As String) As Object
Dim conn As Object
Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & workbookPath & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
Set CreateADODBConnection = conn
End Function
Function GetHTMLDocument(url As String) As Object
Dim http As Object
Dim htmlDoc As Object
' Créer une nouvelle instance de MSXML2.XMLHTTP
Set http = CreateObject("MSXML2.XMLHTTP")
' Envoyer une requête GET pour récupérer le contenu de la page
http.Open "GET", url, False
http.send
' Charger le contenu HTML dans un document
Set htmlDoc = CreateObject("HTMLFile")
htmlDoc.body.innerhtml = http.responseText
Set GetHTMLDocument = htmlDoc
End Function
Function ExtractTideData(tideTable As Object) As Collection
Dim rows As Object
Dim row As Object
Dim tideData As Collection
Dim tideEntry As Collection
Dim dateStr As String
Set tideData = New Collection
' Parcourir chaque ligne de la table HTML
Set rows = tideTable.getElementsByTagName("tr")
For Each row In rows
' Obtenir la date à partir de la première cellule
If row.getElementsByTagName("td").Length > 0 Then
dateStr = row.getElementsByTagName("td")(0).innerText
' Vérifier si la date contient "août" (mois spécifié)
If InStr(dateStr, "août") > 0 Then
' Créer une nouvelle entrée de marée
Set tideEntry = New Collection
tideEntry.Add Replace(dateStr, "Demain", "")
tideEntry.Add row.getElementsByTagName("td")(1).innerText ' Matin Coeff
tideEntry.Add row.getElementsByTagName("td")(2).innerText ' Matin Basse mer
tideEntry.Add row.getElementsByTagName("td")(3).innerText ' Matin Pleine mer
tideEntry.Add row.getElementsByTagName("td")(4).innerText ' Après-midi Coeff
tideEntry.Add row.getElementsByTagName("td")(5).innerText ' Après-midi Basse mer
tideEntry.Add row.getElementsByTagName("td")(6).innerText ' Après-midi Pleine mer
tideData.Add tideEntry
End If
End If
Next row
Set ExtractTideData = tideData
End Function
️
