Código de Access - Beetrack Access

Dim Rst As ADODB.Recordset

Set Rst = New ADODB.Recordset

Dim IdBeeTrack As Double

Dim Status, myurl, Usuario, Clave As String

Dim Cadena As String

Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")

myurl = "https://app.beetrack.com/api/external/v1/routes"

Rst.Open "BeetrackConsulta", CodeProject.Connection, adOpenForwardOnly, adLockReadOnly

Do While Not Rst.EOF

    Cadena = ""

    xmlhttp.Open "POST", myurl, False

    xmlhttp.setRequestHeader "X-AUTH-TOKEN", "1cdrf67tr4ease85c9628870b10593e06b4e5"

    xmlhttp.setRequestHeader "Content-Type", "application/json"

    Cadena = Rst!html

    xmlhttp.Send Cadena

    Cadena = Nz(Trim(xmlhttp.responseText))

    Status = Mid(Cadena, 12, 2)

    If Status = "Ok" Then

       gl_var = SysCmd(acSysCmdSetStatus, "Subiendo a Beetrack Orden de Despacho : " & Rst!IdOrdenDespacho)

       IdBeeTrack = Mid(Cadena, 39, 7)

       cmd.CommandText = "UPDATE Beetrack SET Subido = True, Status = '" & Cadena & "', Idbeetrack = " & QuitarComas(IdBeeTrack) & ", FechaSubido = '" & Now() & "' WHERE IdOrdenDespacho = " & Rst!IdOrdenDespacho

       cmd.Execute

    Else

       cmd.CommandText = "UPDATE Beetrack SET Status = '" & Cadena & "' WHERE IdOrdenDespacho = " & Rst!IdOrdenDespacho

       cmd.Execute

    End If

    Rst.MoveNext

Loop

Rst.Close