' Module Mod_Horaire_Maree_fr
Option Explicit ' Force la déclaration explicite des variables
' Subroutine principale pour tester le fonctionnement
Sub test()
    ' Décommentez la ligne suivante pour rendre la feuille "villes" visible
    ' Sheets("villes").Visible = xlSheetVisible
    ' Appelle la fonction ParVentEtMaré avec le nom de la ville
    ParVentEtMaré "LORIENT", "Lorient"
End Sub
' Subroutine pour obtenir les données de marées d'une ville donnée
Sub ParVentEtMaré(URL As String, Ville As String)
    Dim VILLES() As Ville ' Déclare un tableau de type Ville
    Dim conn As Object ' Déclare un objet pour la connexion ADODB
    ' Créer une connexion ADODB
    Set conn = CreateADODBConnection(ThisWorkbook.FullName)
 
    ' Formater l'URL pour accéder aux données de marées
URL = "https://www.horaire-maree.fr/maree/" & AssainirURL(URL) & "/"
 
    ' Vérifie si l'URL est accessible et si la ville est valide
    If CheckURL(URL, Trim("" & Ville)) Then
        ReDim VILLES(0) ' Redimensionne le tableau pour contenir une ville
        Set VILLES(0) = New Ville ' Crée une nouvelle instance de la classe Ville
     
        ' Récupère les données de marées pour la ville pour le jour actuel
        RetorunVilleJour Trim("" & Ville), VILLES, Now, GetHTMLDocument(URL)
        ' Récupère les données de marées pour les jours suivants
        RetorunVilleJourAprès Trim("" & Ville), VILLES, Now, GetHTMLDocument(URL)
     
        ' Insère les données de marées dans la base de données
        ProcessAndInsertTideData conn, VILLES
    End If
    DoEvents ' Permet au système d'exécuter d'autres tâches
    ' Ferme la connexion ADODB
    conn.Close
    Set conn = Nothing ' Libère l'objet conn
    ReDim VILLES(0) ' Redimensionne le tableau pour le nettoyer
    Erase VILLES ' Efface le tableau
End Sub
' Subroutine pour retourner les données de marées pour un jour donné
Sub RetorunVilleJour(v As String, TbVille() As Ville, D As String, htmlDoc As Object)
    Dim table As Object ' Déclare un objet pour le tableau HTML
    Dim rows As Object ' Déclare un objet pour les lignes du tableau
    Dim cells As Object ' Déclare un objet pour les cellules de la ligne
    Dim row As Object ' Déclare un objet pour une ligne spécifique
    Dim cell As Object ' Déclare un objet pour une cellule spécifique
    Dim I As Integer ' Déclare un index pour les boucles
    ' Sélectionner le tableau à partir du document HTML
    Set table = htmlDoc.getElementById("i_donnesJour").getElementsByTagName("table")(0)
    Set rows = table.getElementsByTagName("tr")
    ' Initialise les valeurs de la première entrée dans le tableau des villes
    TbVille(0).Ville = v
    TbVille(0).MyDate = Format(D, "yyyy-mm-dd")
    ' Parcourt chaque ligne à partir de la 3ème ligne (les données commencent ici)
    For I = 2 To rows.Length - 1
        Set row = rows(I) ' Récupère la ligne actuelle
        Set cells = row.getElementsByTagName("td") ' Récupère les cellules de la ligne
        ' Vérifie que la ligne contient les cellules attendues
        If cells.Length >= 6 Then
            ' Matin Coeff
            If cells(0).innertext <> "" Then
                TbVille(0).Matin_Coeff = cells(0).innertext ' Récupère le coefficient du matin
            End If
            ' Matin Basse Mer
            If cells(1).innertext <> "" Then
                ' Récupère l'heure et le niveau de basse mer
                TbVille(0).Matin_Basse_mere = CDate(Replace(Split(cells(1).innertext, vbCrLf)(0), "h", ":"))
                TbVille(0).Matin_Basse_mere_Niveau_Zéro = Val(Replace(Split(cells(1).innertext, vbCrLf)(1), ",", "."))
            End If
            ' Matin Pleine Mer
            If cells(2).innertext <> "" Then
                ' Récupère l'heure et le niveau de pleine mer
                TbVille(0).Matin_Pleine_mere = CDate(Replace(Split(cells(2).innertext, vbCrLf)(0), "h", ":"))
                TbVille(0).Matin_Pleine_mere_Niveau_Zéro = Val(Replace(Split(cells(2).innertext, vbCrLf)(1), ",", "."))
            End If
            ' Après-midi Coeff
            If cells(3).innertext <> "" Then
                TbVille(0).Après_midi_Coeff = cells(3).innertext ' Récupère le coefficient de l'après-midi
            End If
            ' Après-midi Basse Mer
            If cells(4).innertext <> "" Then
                ' Récupère l'heure et le niveau de basse mer pour l'après-midi
                TbVille(0).Après_midi_Basse_mere = CDate(Replace(Split(cells(4).innertext, vbCrLf)(0), "h", ":"))
                TbVille(0).Après_midi_Basse_mere_Niveau_Zéro = Val(Replace(Split(cells(4).innertext, vbCrLf)(1), ",", "."))
            End If
            ' Après-midi Pleine Mer
            If cells(5).innertext <> "" Then
                ' Récupère l'heure et le niveau de pleine mer pour l'après-midi
                TbVille(0).Après_midi_Pleine_mere = CDate(Replace(Split(cells(5).innertext, vbCrLf)(0), "h", ":"))
                TbVille(0).Après_midi_Pleine_mere_Niveau_Zéro = Val(Replace(Split(cells(5).innertext, vbCrLf)(1), ",", "."))
            End If
        End If
     
        ' Détermine le sens des marées pour le matin et l'après-midi
        TbVille(0).Matin_Sens_Marrées = IIf(TbVille(0).Matin_Basse_mere < TbVille(0).Matin_Pleine_mere, "Marée Montante", "Marée Descendante")
        TbVille(0).Après_midi_Sens_Marrées = IIf(TbVille(0).Après_midi_Basse_mere < TbVille(0).Après_midi_Pleine_mere, "Marée Montante", "Marée Descendante")
    Next I
End Sub
' Fonction pour retourner les données de la feuille VILLES
Function RetournVille()
    RetournVille = ThisWorkbook.Sheets("VILLES").ListObjects("VILLES").DataBodyRange.Value
End Function
' Subroutine pour retourner les données de marées pour les jours suivants
Sub RetorunVilleJourAprès(v As String, TbVille() As Ville, D As Date, htmlDoc As Object)
    Dim table As Object ' Déclare un objet pour le tableau HTML
    Dim rows As Object ' Déclare un objet pour les lignes du tableau
    Dim cells As Object ' Déclare un objet pour les cellules de la ligne
    Dim row As Object ' Déclare un objet pour une ligne spécifique
    Dim cell As Object ' Déclare un objet pour une cellule spécifique
    Dim I As Integer ' Déclare un index pour les boucles
    ' Sélectionner le tableau à partir du document HTML
    Set table = htmlDoc.getElementById("i_donnesLongue").getElementsByTagName("table")(0)
    Set rows = table.getElementsByTagName("tr")
    ' Parcourt chaque ligne à partir de la 3ème ligne (les données commencent ici)
    For I = 2 To rows.Length - 1
        D = D + 1 ' Incrémente la date pour le jour suivant
        ReDim Preserve TbVille(UBound(TbVille) + 1) ' Redimensionne le tableau pour ajouter une ville
        Set TbVille(UBound(TbVille)) = New Ville ' Crée une nouvelle instance de la classe Ville
        TbVille(UBound(TbVille)).Ville = v
        TbVille(UBound(TbVille)).MyDate = Format(D, "yyyy-mm-dd") ' Définit la date de la ville
        Set row = rows(I) ' Récupère la ligne actuelle
        Set cells = row.getElementsByTagName("td") ' Récupère les cellules de la ligne
        ' Vérifie que la ligne contient les cellules attendues
        If cells.Length >= 6 Then
            ' Matin Coeff
            If cells(1).innertext <> "" Then
                TbVille(UBound(TbVille)).Matin_Coeff = cells(0).innertext ' Récupère le coefficient du matin
            End If
            ' Matin Basse Mer
            If cells(1).innertext <> "" Then
                ' Récupère l'heure et le niveau de basse mer
                TbVille(UBound(TbVille)).Matin_Basse_mere = CDate(Replace(Split(cells(1).innertext, vbCrLf)(0), "h", ":"))
                TbVille(UBound(TbVille)).Matin_Basse_mere_Niveau_Zéro = Val(Replace(Split(cells(1).innertext, vbCrLf)(1), ",", "."))
            End If
            ' Matin Pleine Mer
            If cells(2).innertext <> "" Then
                ' Récupère l'heure et le niveau de pleine mer
                TbVille(UBound(TbVille)).Matin_Pleine_mere = CDate(Replace(Split(cells(2).innertext, vbCrLf)(0), "h", ":"))
                TbVille(UBound(TbVille)).Matin_Pleine_mere_Niveau_Zéro = Val(Replace(Split(cells(2).innertext, vbCrLf)(1), ",", "."))
            End If
            ' Après-midi Coeff
            If cells(3).innertext <> "" Then
                TbVille(UBound(TbVille)).Après_midi_Coeff = cells(3).innertext ' Récupère le coefficient de l'après-midi
            End If
            ' Après-midi Basse Mer
            If cells(4).innertext <> "" Then
                ' Récupère l'heure et le niveau de basse mer pour l'après-midi
                TbVille(UBound(TbVille)).Après_midi_Basse_mere = CDate(Replace(Split(cells(4).innertext, vbCrLf)(0), "h", ":"))
                TbVille(UBound(TbVille)).Après_midi_Basse_mere_Niveau_Zéro = Val(Replace(Split(cells(4).innertext, vbCrLf)(1), ",", "."))
            End If
            ' Après-midi Pleine Mer
            If cells(5).innertext <> "" Then
                ' Récupère l'heure et le niveau de pleine mer pour l'après-midi
                TbVille(UBound(TbVille)).Après_midi_Pleine_mere = CDate(Replace(Split(cells(5).innertext, vbCrLf)(0), "h", ":"))
                TbVille(UBound(TbVille)).Après_midi_Pleine_mere_Niveau_Zéro = Val(Replace(Split(cells(5).innertext, vbCrLf)(1), ",", "."))
            End If
        End If
     
        ' Détermine le sens des marées pour le matin et l'après-midi
        TbVille(UBound(TbVille)).Matin_Sens_Marrées = IIf(TbVille(UBound(TbVille)).Matin_Basse_mere < TbVille(UBound(TbVille)).Matin_Pleine_mere, "Marée Montante", "Marée Descendante")
        TbVille(UBound(TbVille)).Après_midi_Sens_Marrées = IIf(TbVille(UBound(TbVille)).Après_midi_Basse_mere < TbVille(UBound(TbVille)).Après_midi_Pleine_mere, "Marée Montante", "Marée Descendante")
    Next I
End Sub
Sub ProcessAndInsertTideData(conn As Object, VILLES() As Ville)
    Dim v As Integer
    Dim Sql As String
    Dim rs As Object
    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 ' 1 = adOpenKeyset, 3 = adLockOptimistic
        If rs.EOF Then rs.AddNew ' Insérer une nouvelle ligne si la date et la ville n'existent pas
         
        ' Assignation des valeurs aux champs du Recordset
        rs.Fields("Ville").Value = "" & VILLES(v).Ville
        rs.Fields("Date").Value = "" & VILLES(v).MyDate
        rs.Fields("Matin Coeff").Value = IIf("" & VILLES(v).Matin_Coeff = "", Null, "" & VILLES(v).Matin_Coeff)
    
        rs.Fields("Matin Basse mer").Value = IIf("" & VILLES(v).Matin_Basse_mere = "", Null, "" & VILLES(v).Matin_Basse_mere)
        rs.Fields("Matin Basse mer Niveau Zéro").Value = IIf("" & VILLES(v).Matin_Basse_mere_Niveau_Zéro = "", Null, "" & VILLES(v).Matin_Basse_mere_Niveau_Zéro)
     
        rs.Fields("Matin Pleine mer").Value = IIf("" & VILLES(v).Matin_Pleine_mere = "", Null, "" & VILLES(v).Matin_Pleine_mere)
        rs.Fields("Matin Pleine mer Niveau Zéro").Value = IIf("" & VILLES(v).Matin_Pleine_mere_Niveau_Zéro = "", Null, "" & VILLES(v).Matin_Pleine_mere_Niveau_Zéro)
        rs.Fields("Matin Sens Marrées").Value = IIf("" & VILLES(v).Matin_Sens_Marrées = "", Null, "" & VILLES(v).Matin_Sens_Marrées)
     
        rs.Fields("Après-midi Coeff").Value = IIf("" & VILLES(v).Après_midi_Coeff = "", Null, "" & VILLES(v).Après_midi_Coeff)
     
        rs.Fields("Après-midi Basse mer").Value = IIf("" & VILLES(v).Après_midi_Basse_mere = "", Null, "" & VILLES(v).Après_midi_Basse_mere)
        rs.Fields("Après-midi Basse mer Niveau Zéro").Value = IIf("" & VILLES(v).Après_midi_Basse_mere_Niveau_Zéro = "", Null, "" & VILLES(v).Après_midi_Basse_mere_Niveau_Zéro)
    
        rs.Fields("Après-midi Pleine mer").Value = IIf("" & VILLES(v).Après_midi_Pleine_mere = "", Null, "" & VILLES(v).Après_midi_Pleine_mere)
        rs.Fields("Après-midi Pleine mer Niveau Zéro").Value = IIf("" & VILLES(v).Après_midi_Pleine_mere_Niveau_Zéro = "", Null, "" & VILLES(v).Après_midi_Pleine_mere_Niveau_Zéro)
        rs.Fields("Après-midi Sens Marrées").Value = IIf("" & VILLES(v).Après_midi_Sens_Marrées = "", Null, "" & VILLES(v).Après_midi_Sens_Marrées)
     
        rs.Update ' Met à jour le Recordset
    Next v
End Sub
' Fonction pour vérifier l'accessibilité d'une URL
Function CheckURL(URL As String, Ville As String) As Boolean
    Dim xml As Object ' Déclare un objet pour la requête XMLHTTP
    Set xml = CreateObject("MSXML2.XMLHTTP") ' Crée une requête XMLHTTP
    On Error Resume Next ' Ignore les erreurs
    ' Envoie une requête GET à l'URL
    xml.Open "GET", URL, False
    xml.send
    ' Vérifie si la réponse est un succès
    If xml.Status = 200 Then
        CheckURL = True ' L'URL est accessible
    Else
        CheckURL = False ' L'URL n'est pas accessible
    End If
    On Error GoTo 0 ' Réactive les erreurs
End Function
' Fonction pour assainir une URL (remplacer les espaces par des tirets)
Function AssainirURL(URL As String) As String
    Dim res As String ' Déclare une variable pour le résultat
    res = Trim(URL) ' Supprime les espaces autour de l'URL
    res = Replace(res, " ", "-") ' Remplace les espaces par des tirets
    AssainirURL = res ' Retourne l'URL assainie
End Function
' Fonction pour créer une connexion ADODB
Function CreateADODBConnection(dbPath As String) As Object
    Dim conn As Object ' Déclare un objet pour la connexion
    Set conn = CreateObject("ADODB.Connection") ' Crée une connexion ADODB
    conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath & ";Persist Security Info=False;" ' Chaîne de connexion
    conn.Open ' Ouvre la connexion
    Set CreateADODBConnection = conn ' Retourne l'objet de connexion
End Function
' Fonction pour obtenir le document HTML à partir d'une URL
Function GetHTMLDocument(URL As String) As Object
    Dim xml As Object ' Déclare un objet pour la requête XMLHTTP
    Set xml = CreateObject("MSXML2.XMLHTTP") ' Crée une requête XMLHTTP
    ' Envoie une requête GET à l'URL
    xml.Open "GET", URL, False
    xml.send
    ' Crée un document HTML et charge le contenu
    Dim htmlDoc As Object
    Set htmlDoc = CreateObject("htmlfile")
    htmlDoc.body.innerHTML = xml.responseText ' Charge le texte de la réponse dans le document HTML
    Set GetHTMLDocument = htmlDoc ' Retourne le document HTML
End Function
' Class pour définir une ville
Class Ville
    Public Ville As String ' Nom de la ville
    Public MyDate As String ' Date pour les marées
    Public Matin_Coeff As String ' Coefficient de la marée du matin
    Public Matin_Basse_mere As Date ' Heure de la basse mer du matin
    Public Matin_Basse_mere_Niveau_Zéro As Double ' Niveau de la basse mer du matin
    Public Matin_Pleine_mere As Date ' Heure de la pleine mer du matin
    Public Matin_Pleine_mere_Niveau_Zéro As Double ' Niveau de la pleine mer du matin
    Public Après_midi_Coeff As String ' Coefficient de la marée de l'après-midi
    Public Après_midi_Basse_mere As Date ' Heure de la basse mer de l'après-midi
    Public Après_midi_Basse_mere_Niveau_Zéro As Double ' Niveau de la basse mer de l'après-midi
    Public Après_midi_Pleine_mere As Date ' Heure de la pleine mer de l'après-midi
    Public Après_midi_Pleine_mere_Niveau_Zéro As Double ' Niveau de la pleine mer de l'après-midi
    Public Matin_Sens_Marrées As String ' Sens de la marée du matin
    Public Après_midi_Sens_Marrées As String ' Sens de la marée de l'après-midi
End Class
[:code]