Učitavanje dodađaja između dva datuma, Datum_P i Datum_K (text box).

Private Sub cmdUcitajDogadjaje_Click()


If IsNull(Me.Datum_P) = True Or IsNull(Me.Datum_K) = True Then GoTo Greska

Pocetak:
DatumW = Format(Datum_P, "yyyy-mm-dd") ' TextBox na formi

Me.Text160 = Me.Datum_P

'MsgBox DatumW

Call UcitajDogadjaje(DatumW)

Me.Datum_P = Me.Datum_P + 1
'Brojac sekundi-------------------
Dim PauseTime, Start, Finish, TotalTime
PauseTime = 0.5 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
Finish = Timer ' Set end time.
'------------------------------------------------------

Me.Text160 = Me.Datum_P

'Brojac sekundi----------------------------------------------
'Dim PauseTime, Start, Finish, TotalTime
PauseTime = 0.5 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
Finish = Timer ' Set end time.
'------------------------------------------------------

If Me.Datum_P > Me.Datum_K Then
GoTo Predkraj
Else:
GoTo Pocetak
End If


Predkraj:
'MsgBox "Obrada završena !!!", vbInformation
GoTo Kraj

Greska:
MsgBox "INESITE ISPRAVNO DATUME !!!", vbInformation

Kraj:

End Sub

Public Sub UcitajDogadjaje(DatumW As String)

Dim http As Object
Dim json As Object
Dim items As Object
Dim item As Object

Dim urlD As String
Dim responseText As String

'MsgBox DatumW

urlD = "https://api.eotpremnica.mfin.g...uments/suppliers/changes?date=" _
& DatumW & "&page=0"

Set http = CreateObject("MSXML2.XMLHTTP")

http.Open "GET", urlD, False
http.setRequestHeader "Accept", "application/json"
http.setRequestHeader "Api-key", apiKey
http.send

If http.status <> 200 Then
MsgBox "Greška API: " & http.status, vbCritical
Exit Sub
End If

responseText = http.responseText
Me.Text150 = responseText


Set json = JsonConverter.ParseJson(responseText)
Set items = json("items")

For Each item In items
Call ObradiDogadjaj(item)
Next item

End Sub


Private Sub ObradiDogadjaj(item As Object)

Dim db As DAO.Database
Dim sql As String

Dim docNumber As Long
Dim eoId As String
Dim eopId As String

Set db = CurrentDb

' ---- DespatchAdvice (uvek postoji)
docNumber = CLng(left(item("data")("despatchAdvice")("documentNumber"), Len(item("data")("despatchAdvice")("documentNumber")) - 3))
docNumber_Year = CLng(right(item("data")("despatchAdvice")("documentNumber"), 2))
'docNumber = item("data")("despatchAdvice")("documentNumber")
eoId = """" & item("data")("despatchAdvice")("id") & """"
datumDok = Format(DatumW, "mm/dd/yyyy")

'strDatum = "#" & Format(Me.Datum, "mm/dd/yyyy") & "#"
'MsgBox docNumber
'MsgBox eoId

' ---- Upis EO_ID
'Brojac sekundi-------------------
Dim PauseTime, Start, Finish, TotalTime
PauseTime = 0.01 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
Finish = Timer ' Set end time.
'------------------------------------------------------
'EO_ID-ID otpremnice, EO-oznaka da je napravljena
sql = "UPDATE Promet SET Promet.EO_ID = " & eoId & ", Promet.EO = 1 WHERE (((Promet.Broj_racuna)= " & docNumber & ") AND ((Promet.Predznak)=-1) AND ((Promet.Faktura)=1) AND ((Promet.Knj)=False) AND ((Promet.Int)=False) AND ((Promet.eo)=0 OR isnull(promet.eo)=true ) AND (clng(format(Promet.datum,""yy""))=" & docNumber_Year & "));"

'Brojac sekundi-------------------
'Dim PauseTime, Start, Finish, TotalTime
PauseTime = 0.01 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
Finish = Timer ' Set end time.
'------------------------------------------------------

'DoCmd.OpenQuery sql
db.Execute sql, dbFailOnError
Debug.Print db.RecordsAffected

End Sub



Pocetak razvoza ide preko aplikacije MATP koja se skida sa njihovog sajta i podesava prema vozacima.

Pozdrav