Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Запрос даты и времени из Интернета
 
#1
01.12.2021 11:58:34

Всем добрый день. Подсмотрел в интернете макрос по получению даты и времени из интернета, при запуске процедуры "ВывестиТекущуюДатуИВремя" выводит вместо даты 00:00:00, может кто сможет подсказать что не так?

Код
Function GetRealTime(Optional ByVal GMT& = 4) As Date
    On Error Resume Next: Err.Clear: Dim http As Object, URL$, GMT_Time$, m$, mv$
    'GetRealTime = Now        ' значение по-умолчанию

    Set http = CreateObject("Microsoft.XMLHTTP")
    URL$ = "http://yandex.ru/"        ' можно указать практически любой сайт
    http.Open "GET", URL$, False
    http.Send
 
    GMT_Time = http.GetResponseHeader("Date")
    Set http = Nothing
 
    ' пример полученной строки:  Sun, 27 Apr 2014 06:14:44 GMT
    'If Not (GMT_Time Like "???, *# ??? #### ##:##:##*GMT*") Then Exit Function
    GMT_Time = Trim(Split(GMT_Time, ",")(1))
    GMT_Time = Trim(Split(GMT_Time, "GMT")(0))
    m$ = Trim(Split(GMT_Time)(1))
    mv$ = (InStr(1, "janfebmaraprmayjunjulaugsepoctnovdec", m$, vbTextCompare) + 2) / 3
    GMT_Time = Replace(GMT_Time, " " & m$ & " ", "." & Format(mv$, "00") & ".")
 
    GetRealTime = CDate(GMT_Time) + Val(GMT&) / 24
End Function

Sub ВывестиТекущуюДатуИВремя()
    t = GetRealTime
    MsgBox t, vbInformation, "Текущее время (в Москве)"
 End Sub
 
 
 
#2
01.12.2021 12:09:17
Paren, здравствуйте

Цитата
Paren: Подсмотрел в интернете макрос по получению даты и времени из интернета
а зачем вам из интеренета? Штатный Timer или Now ТОЧНО не устроит?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#3
01.12.2021 12:42:26
У меня зашит штатный таймер в файл, который отпраляеется группе лиц в том числе руководству, и если дата больше указанной в коде - файл самоудаляет вкладки и выкл макрос. Проблема в том, что данные пользователи, будучи безграмотными в макросах не смогут исправить код, а вот дату в виндоус перевести на месяц назад смогут и файл не удалит вкладки. Решил попробовать доставать дату из интернета а не из виндоус, чтобы дату откатить не могли. И на макрос я наложил пароль, чтобы не так просто было его поправить если вдруг все же додумаются и сам код очень коряво написал, для плохой читабельности.
 
 
 
#4
01.12.2021 12:50:28
Paren, Получение текущей даты и времени с сервера в интернете

P.S.:
защита лютая, конечно — перевести время могут, а отключить доступ в интернет или просто запретить макросы - нет  :D
Изменено: Jack Famous - 01.12.2021 12:51:36
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#5
01.12.2021 12:54:55
Как раз этот макрос и выводит 00:00:00 (((
Запретить макрос могут, но тогда отчет не будет считаться и данные будут бесполезны. А на счет отключить интернет, такого не получиться, так как интернет корпоративный и нужны админ права, да еще до такого додуматься нужно. А я две проверки зашью, одну из интернета, другую от виндоус.:))))
Изменено: Paren - 01.12.2021 12:57:52
 
 
 
#6
01.12.2021 12:57:05
Paren,  подумайте сразу о том что в какой то момент будет недоступен интернет, сайт, или процедура даст сбой. В любом случае я б сравнивал с системным временем, на случай расхождений.  ну и конечно нужно учесть, что если доменный ПК имеет отличное время от контроллера на более 5 минут, то он не сможет работать . то есть внешняя подстраховка нужно только для компов в рабочих группах.
По вопросам из тем форума, личку не читаю.
 
 
 
#7
01.12.2021 13:06:28
Фишка в том, что если дата просрочена файл удаляет вкладки, сохраняется и закрывается, о том что стоит дата проверки никто не знает, я ее по умолчанию обновляю, а старые файлы этого отчета никто не смотрит, всем нужны новые и файл собирается накопительно ежедневно. Файл как раз открываетсяч на компах в рабочих группах, но кто-то может его забрать домой.
Изменено: Paren - 01.12.2021 13:07:10
 
 
 
#8
01.12.2021 15:31:19
Цитата
Paren написал:
' можно указать практически любой сайт
но не любой :-)
https://time100.ru/ и все работает. Пока. :-)
По вопросам из тем форума, личку не читаю.
 
 
 
#9
01.12.2021 19:28:49
На этом же сайте кипит работа.  :)  
Владимир
 
 
 
#10
02.12.2021 17:09:13
Исправил функцию у себя на сайте
Теперь снова работает
Достаточно было обновить ссылку: URL$ = "https://yandex.ru/"
 
 
 
#11
02.12.2021 17:21:55
Игорь,
что-то неверное время даёт (+1 час к Москве). Запустил реальное время 17:20, а макрос показывает 18:20

Код
Sub ВывестиТекущуюДатуИВремя()
Dim t
    t = GetRealTime
    MsgBox t, vbInformation, "Текущее время (в Москве)"
End Sub

Function GetRealTime(Optional ByVal GMT& = 4) As Date
    ' © 2021 ExcelVBA.ru
    On Error Resume Next: Err.Clear: Dim http As Object, URL$, GMT_Time$, m$, mv$
    'GetRealTime = Now        ' значение по-умолчанию

    Set http = CreateObject("Microsoft.XMLHTTP")
    URL$ = "https://yandex.ru/"        ' можно указать практически любой сайт
    http.Open "GET", URL$, False
    http.Send
 
    GMT_Time = http.GetResponseHeader("Date")
    Set http = Nothing
 
    ' пример полученной строки:  Sun, 27 Apr 2014 06:14:44 GMT
    If Not (GMT_Time Like "???, *# ??? #### ##:##:##*GMT*") Then Exit Function
 
    GMT_Time = Trim(Split(GMT_Time, ",")(1))
    GMT_Time = Trim(Split(GMT_Time, "GMT")(0))
    m$ = Trim(Split(GMT_Time)(1))
    mv$ = (InStr(1, "janfebmaraprmayjunjulaugsepoctnovdec", m$, vbTextCompare) + 2) / 3
    GMT_Time = Replace(GMT_Time, " " & m$ & " ", "." & Format(mv$, "00") & ".")
 
    GetRealTime = CDate(GMT_Time) + Val(GMT&) / 24
End Function
Изменено: New - 02.12.2021 17:22:06
 
 
 
#12
02.12.2021 17:32:53
Часовой пояс правильно укажите здесь:
Optional ByVal GMT& = 4
Для Москвы это будет 3
 
 
 
#13
02.12.2021 17:33:07
так Optional ByVal GMT& = 4 уже давно 3

Игорь,  а нет ли смысла по умолчанию брать системную TZ
По вопросам из тем форума, личку не читаю.
 
 
 
#14
02.12.2021 17:38:09
Цитата
написал:
а вот дату в виндоус перевести на месяц назад смогу
так не давайте им этого делать административными ресурсами и все)))
 
 
 
#15
02.12.2021 17:43:18
Игорь, сбивает с толку русский текст на сайте

Изменено: New - 02.12.2021 17:43:27
 
 
 
Страницы: 1
Наверх