Martha, después de los insultos a que ha sido objeto, le dejo una función de Christos Samaras
Pego la url en el campo y hago clic sobre el botón Url. Obtngo en el campo Fecha la fecha y hora del servidor.
Código del botón Url
Private Sub btnURL_Click()
If IsNull(Me.ctlURL) Then
MsgBox "Se requiere la url", vbInformation, "Error.."
Else
Me.ctlFechaURL = InternetTime(Me.ctlURL, 1)
End If
End Sub
El primer parámetro es la url y el segundo es la diferencia de tiempo está entre -12 y 14.
Código de la función InternetTime
Function InternetTime(url As String, Optional GMTDifference As Integer) As Date
'-----------------------------------------------------------------------------------
'Esta función devuelve el meridiano de Greenwich obtenido de un servidor de Internet.
'Puede usar el argumento opcional GMTDifference para sumar (o restar)
'una hora desde la hora GMT. Por ejemplo, si llama a la función como:
'=InternetTime(2) devolverá la hora (local) GMT + 2. Tenga en cuenta que el
'La variable GMTDifference es un número entero.
'Written by: Christos Samaras
'Date: 25/09/2013
'Last Updated: 10/01/2017
'e-mail: [email protected]
'site: https://myengineeringworld.net/////
'-------------------------------------------------------------------------------
'Declaring the necessary variables.
Dim Request As Object
Dim ServerURL As String
Dim Results As String
Dim NetDate As String
Dim NetTime As Date
Dim LocalDate As Date
Dim LocalTime As Date
'Check if the time difference is within the accepted range.
If GMTDifference < -12 Or GMTDifference > 14 Then
Exit Function
End If
'The server address.
'ServerURL = "http://www.timeanddate.com/worldclock/fullscreen.html?n=2"
'ServerURL = "https://clients.cloudclusters.io/"
ServerURL = url
'Build the XMLHTTP object and check if was created successfully.
On Error Resume Next
Set Request = CreateObject("MSXML2.ServerXMLHTTP.6.0")
If Err.Number <> 0 Then
Exit Function
End If
On Error GoTo 0
'Create the request.
Request. Open "GET", ServerURL, False, "", ""
'Send the request to the internet server.
Request. Send
'Based on the status node result, proceed accordingly.
If Request.ReadyState = 4 Then
'If the request succeed, the following line will return
'something like this: Mon, 30 Sep 2013 18:33:23 GMT.
Results = Request.getResponseHeader("date")
'Use the Mid function to get something like: 30 Sep 2013 18:33:23.
Results = Mid(Results, 6, Len(Results) - 9)
'Use the Left and Right function to distinguish the date and time.
NetDate = Left(Results, Len(Results) - 9) '30 Sep 2013
NetTime = Right(Results, 8) '18:33:23
'Convert the date into a valid Excel date 30 Sep 2013 -> 30/9/2013.
'Required for countries that have some non-Latin characters at their alphabet (Greece, Russia, Serbia etc.).
LocalDate = ConvertDate(NetDate)
'Add the hour difference to the retrieved GMT time.
LocalTime = NetTime + GMTDifference / 24
'Return the local date and time.
InternetTime = LocalDate + LocalTime
End If
'Release the XMLHTTP object.
Set Request = Nothing
End Function
Solo adicione el paso de la url como parámetro. Martha así a otros no les guste sus preguntas trato de dar respuesta, lo importante es que el código puede servir a otros usuarios. No es enviar la respuesta a su correo como dice otro, sino que sea visible a todos.