Pickup time from Internet servers

[dineshsachidananda]

Hi all,

Kindly refer to the attachment.

Column C has a list of city names.. Is there a way we can pull the current time from any website or internet server.
If not only the time zone they fall under

[JasperD]

You're looking for something like the code below, I suspect.
Set references to Microsoft XML and Microsoft HTML

Sub excelforum()
Dim TaD As MSXML2.XMLHTTP, TD As MSHTML.HTMLDocument, cell As Range
Dim url$, country$, city$

On Error GoTo earlyexit

Set TaD = New MSXML2.XMLHTTP
Set TD = New HTMLDocument
url = "http://www.timeanddate.com/worldclock/"

For Each cell In Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row)
If Cells(cell.Row, 1) = "United States" Then country = "usa" Else country = LCase(Cells(cell.Row, 1))
country = Replace(country, " ", "-")
city = Replace(LCase(Cells(cell.Row, 3)), " ", "-")


TaD.Open "GET", url & "/" & country & "/" & city, False
TaD.send
TD.body.innerhtml = TaD.responseText

If InStr(TaD.responseText, "Unknown address") > 0 Then
cell.Offset(0, 1) = "Couldn't find the time, sorry!"
Else
cell.Offset(0, 1) = TD.getElementById("qlook").innerText
End If

Next cell

earlyexit:
Application.ScreenUpdating = True
End Sub

Please click the * below if this helps

[dineshsachidananda]

Hi Jasper.. thanks for the help..

I did try running the code .. but it gave me an compile error message.

Attached screenshot.. Kindly assist

[dineshsachidananda]

ATTACHED output of the VBA.... we almos there...

the D column is giving us result in non english, also, can we not just search with the City name if that helps for more results

Kindly advise

[dineshsachidananda]

it was the reference.. i was able to run it... checkin it now

[JasperD]

You can't search with just city name.
The result will always be in your system language, since that's how the website presents it.

If you find another site that gives the result in English and is flexibile enough to search for the city AND find what you need, then feel free to let me know.
But be careful with just looking for city, because if you'd look for "London", you'd get 4 hits in 3 different countries.

[dineshsachidananda]

I agree to your feedback...

Can we try http://www.thetimenow.com/

[JasperD]

That site poses the exact same problems as the one I used.
I don't really feel the necessity to change it around, but feel free to adjust the code to your liking.

As long as you don't type the country / state / city names exactly as expected by the site, you'll always going to get misses.

[dineshsachidananda]

Okay...
Jasper, just wanted to get this clarified further.. When i execute this code.. I get unknown address for almost 40 city's.. But when I search for them in the website.. It works absolutely fine.. Are we missing anything here..

Please advise..

[JasperD]

This won't find the time for:

"Oakville, Canada" = Doesn't exist on the site
"Beyazit-Istanb" = "Istanbul"
"Sharm el Sheik" = "Sharm ash Shaykh"
"Moscow, Russian Federation" = "Moscow, Russia"
"Victoria - Mah, Seychelles" = "Victoria, Seychelles"
"Bangalore - India" = Doesn't exist on the site
"Enfield, Canada" = Doesn't exist on the site

etc.

[JasperD]

Try

Sub excelforum()
Dim TaD As MSXML2.XMLHTTP, cell As Range
Dim url$, city$, x&

On Error GoTo earlyexit

Set TaD = New MSXML2.XMLHTTP
url = "http://www.thetimenow.com/suggest.php?location="

For Each cell In Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row)
city = Replace(LCase(Cells(cell.Row, 3)), " ", "+")
x = 0

TaD.Open "GET", url & city, False
TaD.send

If TaD.responseText = "[]" Then cell.Offset(0, 1) = "Couldn't find the time, sorry!": GoTo nxc:
If Not cell.Offset(0, -1) = vbNullString And Not cell.Offset(0, -1) = "Unknown" Then x = InStr(TaD.responseText, cell.Offset(0, -1))
If x > 0 Then cell.Offset(0, 1) = Mid(TaD.responseText, InStr(x, TaD.responseText, Chr(34) & "," & Chr(34)) + 3, 5): GoTo nxc
x = InStr(TaD.responseText, cell.Offset(0, -2)) - 8
If x > 0 Then cell.Offset(0, 1) = Mid(TaD.responseText, x, 5): GoTo nxc
cell.Offset(0, 1) = "Couldn't find the time, sorry!"

nxc:
Next cell

earlyexit:
Application.ScreenUpdating = True
End Sub

Please click the * below if this helps

[JasperD]

Gotta love Internet cache :-)
Try

Sub excelforum()
Application.ScreenUpdating = False

Dim TaD As MSXML2.XMLHTTP, cell As Range
Dim url$, city$, x&

On Error GoTo earlyexit

Set TaD = New MSXML2.XMLHTTP
url = "http://www.thetimenow.com/suggest.php?location="

For Each cell In Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row)
Application.ScreenUpdating = True
cell.Activate
DoEvents
Application.ScreenUpdating = False

city = Replace(LCase(Cells(cell.Row, 3)), " ", "+")
x = 0

TaD.Open "GET", url & city & "&" & CInt(1000 * Rnd()), False
TaD.send

If TaD.responseText = "[]" Then cell.Offset(0, 1) = "Couldn't find the time, sorry!": GoTo nxc:
If Not cell.Offset(0, -1) = vbNullString And Not cell.Offset(0, -1) = "Unknown" Then x = InStr(TaD.responseText, cell.Offset(0, -1))
If x > 0 Then cell.Offset(0, 1) = Mid(TaD.responseText, InStr(x, TaD.responseText, Chr(34) & "," & Chr(34)) + 3, 5): GoTo nxc
x = InStr(TaD.responseText, cell.Offset(0, -2)) - 8
If x > 0 Then cell.Offset(0, 1) = Mid(TaD.responseText, x, 5): GoTo nxc
cell.Offset(0, 1) = "Couldn't find the time, sorry!"

nxc:
Next cell

earlyexit:
Application.ScreenUpdating = True
End Sub

Typing from phone, so untested

[dineshsachidananda]

this works absolutely fine.. Just that after few min when I exceute same code again, it does not update. It gives the same result of the first execute

I have to relaunch excel file and run the code again to get an updated time

[dineshsachidananda]

supe supee.. double cheerz to u... thanks a lot... that work perfect