............ Foro Excel
Si no lo has hecho aún: REGISTRATE!!!

Actualizar la fecha/hora del sistema con servidor de internet

Ver el tema anterior Ver el tema siguiente Ir abajo

Actualizar la fecha/hora del sistema con servidor de internet

Mensaje por P@li el Vie Jun 05, 2009 8:13 am

Esta fue una consulta que se realizó en el foro exceluciones,

"Necesito hacer un comparativo de horas con diferentes paises. Alguien sabe como tomar la hora de algun servidor de internet? Alguien sabe como se calcula cuando los paises tienen cambio de zona horaria? "

La respuesta no fue exactamente lo pedido, ya que este código lo hice hace tiempo, pero cubre uno de los puntos en cuestión, tomar la hora de un servidor de internet, y agrega como cambiar la hora del sistema con API's, en base a los valores obtenidos.

Código:

Option Explicit

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Private Declare Function SetSystemTime Lib "kernel32" (lpSystemTime _
As SYSTEMTIME) As Long

Sub ActualizarFechaHora()

    Dim lReturn As Long
    Dim lpSystemTime As SYSTEMTIME
    Dim gmt As Long
    Dim xml As Object 'As XMLHTTP
    Dim horaServidor As Date
   
    Set xml = CreateObject("MSXML2.XMLHTTP")
    xml.open "HEAD", "http://www.google.com.ar/" & Timer, False
   
    xml.send
    If xml.readyState = 4 Then
        horaServidor = Mid(xml.getResponseHeader("Date"), 5, 20)
    Else
        Exit Sub
    End If
    Set xml = Nothing
   
   
    'el horario gmt, esta siempre configurado en el sistema operativo
    'al actualizar la hora del sistema, lo adapta al uso horario
    'por lo que nosotros no tenemos que acomodarlo
    'pero dejo igualmente esas lineas comentadas, por si se le
    'quiere dar otra utilidad al codigo, esa es una manera de acomodar
    'el horario del servidor al uso horario en el que nos encontramos
   
    'gmt = -3 '(argentina)
    'horaServidor = DateAdd("h", gmt, horaServidor)
   
    lpSystemTime.wYear = Year(horaServidor)
    lpSystemTime.wMonth = Month(horaServidor)
    lpSystemTime.wDayOfWeek = Weekday(horaServidor)
    lpSystemTime.wDay = Day(horaServidor)
    lpSystemTime.wHour = Hour(horaServidor)
    lpSystemTime.wMinute = Minute(horaServidor)
    lpSystemTime.wSecond = Second(horaServidor)
    lpSystemTime.wMilliseconds = 0
    lReturn = SetSystemTime(lpSystemTime)
End Sub

Bueno, espero que sea de utilidad.
Saludos.

P@li
Admin

Masculino Cantidad de envíos : 243
Edad : 34
Ciudad - Pais : Buenos Aires, Argentina
Version de Excel : Microsoft Excel 2002 (10.2614.2625)
Fecha de inscripción : 03/03/2008

Volver arriba Ir abajo

Gracias, me fue de gran utilidad

Mensaje por ramirez_rrj81 el Miér Jul 31, 2013 12:29 am

Hola, excelente codigo, justo lo que andaba buscando para no tener que meter pilas nuevas a las PCs

ramirez_rrj81

Masculino Cantidad de envíos : 1
Edad : 37
Ciudad - Pais : mexico
Version de Excel : 2007
Fecha de inscripción : 31/07/2013

Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.