Option
Explicit
Public
Sub
getWeatherData()
Dim
httpReq
As
New
WinHttp.WinHttpRequest
With
httpReq
.SetTimeouts
"2000"
,
"2000"
,
"2000"
,
"2000"
.Send
If
Not
.StatusText =
"OK"
Then
GoTo
cleanUp
End
If
End
With
Dim
objJson
As
Object
Dim
l
As
Long
On
Error
GoTo
cleanUp
Set
objJson = ParseJson(httpReq.ResponseText)
If
Not
objJson(
"results"
)(
"status"
) =
"OK"
Then
GoTo
cleanUp
End
If
With
Worksheets(
"Tabelle1"
)
.Cells(1, 1).Value = objJson(
"results"
)(
"sunrise"
)
.Cells(1, 2).Value = objJson(
"results"
)(
"sunset"
)
.Cells(1, 3).Value = objJson(
"results"
)(
"solar_noon"
)
.Cells(1, 4).Value = objJson(
"results"
)(
"day_length"
)
.Cells(1, 5).Value = objJson(
"results"
)(
"solar_noon"
)
.Cells(1, 6).Value = objJson(
"results"
)(
"civil_twilight_begin"
)
.Cells(1, 7).Value = objJson(
"results"
)(
"civil_twilight_begin"
)
.Cells(1, 8).Value = objJson(
"results"
)(
"nautical_twilight_begin"
)
End
With
On
Error
GoTo
0
MsgBox
"Fertig."
, vbInformation
cleanUp:
If
Err.Number <> 0
Then
MsgBox
"Es ist leider ein Fehler aufgetreten."
& vbCrLf & _
"Fehlernummer: "
& Err.Number & vbCrLf & _
"Fehlerbeschreibung: "
& Err.Description, vbExclamation
End
If
If
Not
httpReq
Is
Nothing
Then
Set
httpReq =
Nothing
If
Not
objJson
Is
Nothing
Then
Set
objJson =
Nothing
End
Sub