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