Private Sub aa() 'CommandButton4_Click()
'Merci à PMO
'Patrick Morange
Dim IE As Object 'As SHDocVw.InternetExplorer
Dim DOC As Object 'As MSHTML.HTMLDocument
Dim A$
Dim B$
Dim i&
Dim LAT$
Dim LON$
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate (WEB_SITE)
Do Until IE.ReadyState = 4 'READYSTATE_COMPLETE
DoEvents
Loop
IE.Visible = True
Set DOC = IE.Document
A$ = IE.Document.DocumentElement.innerHTML
IE.Quit
Set IE = Nothing
'--- Recherche les infos heure universelle ---
A$ = Mid(A$, InStr(1, A$, "<PRE><BR>") + 9)
A$ = Mid(A$, 1, InStr(1, A$, " UTC") - 1)
'--- Jour et heure ---
Dim maDate As Date
Dim Conversion As Variant
[COLOR="Blue"]'////////////
Conversion = Array("Janvier", "Jan", "Février", "Feb", "Mars", "Mar", "Avril", "Apr", _
"Mai", "May", "Juin", "Jun", "Juillet", "Jul", "Août", "Aug", "Septembre", "Sep", _
"Octobre", "Oct", "Novembre", "Nov", "Décembre", "Dec")
For i& = 1 To 23 Step 2
If LCase(Left(A$, 3)) = LCase(Conversion(i&)) Then
A$ = Conversion(i& - 1) & Mid(A$, 4)
Exit For
End If
Next i&
'////////////[/COLOR]
maDate = CDate((Mid(A$, 1, InStr(1, A$, ",") - 1)) & Space(1) & (Mid(A$, InStr(1, A$, ",") + 1)))
'°°° Une heure de décalage UTC vs Paris °°°
maDate = maDate + 1 / 24
'°°° Une heure de décalage heure d'été °°°
If HeureEte(maDate) Then maDate = maDate + 1 / 24
Sheets("Feuil1").Range("g3").Value = Format(maDate, "dd/mm/yyyy")
Sheets("Feuil1").Range("h3").Value = Format(maDate, "hh:mm:ss")
Dim message, title, defaultValue As String
Dim myValue As String
message = "Mettre votre prénom svp"
title = "Prénom"
defaultValue = "Prénom"
myValue = InputBox(message, title, defaultValue)
If myValue = "" Then myValue = defaultValue
Sheets("Feuil1").Range("b3").Value = myValue
Dim ol As New Outlook.Application
Dim olmail As MailItem
Set ol = New Outlook.Application
Set olmail = ol.CreateItem(olMailItem)
'Caractéristiques de l'e-mail
With olmail
.To = Sheets("Feuil1").Range("A3").Value
'Affiche le nom comme objet du message
.Subject = "Pointage le " & Sheets("Feuil1").Range("g3").Value & " à " & Sheets("Feuil1").Range("h3").Value
.Body = "Bonjour, le magasin est ouvert." & vbLf & vbLf & vbLf & _
myValue & vbLf & Application.UserName
'Remplacez .Display par .send pour envoyer directement l'e-mail sans l'afficher dans Outlook
'.Send
.Display
End With
End Sub