Código de Access - Beetrack Access Json

Filtrado por el tag: toast

<<>>

Pos: 77

Val: 32

Ha mantenido su posición en Access (en relación al último mes)

Beetrack Access Json

Access

Publicado el 28 de Mayo del 2020 por Julio (3 códigos)

1.243 visualizaciones desde el 28 de Mayo del 2020

Permite crear un string en Json para posteriormente enviarlo a la Api de Beetrack

2019

Publicado el 28 de Mayo del 2020

1.244 visualizaciones desde el 28 de Mayo del 2020

' Beetrack

If Nz(DLookup("beetrack", "moneda"), 0) = True Then

   If Nz(Me.IdVehiculo.Column(2), 0) = -1 Then

      Dim vPedC As Integer

      Dim vPed As Double

      Dim vTag As String

      Dim cmd As New ADODB.Command

      Set cmd.ActiveConnection = CodeProject.Connection

      vPedC = 0

      Sql = "SELECT OrdenDespacho.IdOrdenDespacho, OrdenDespacho.NroDespacho ,OrdenDespachoDetalle.IdPedido,OrdenDespacho.IdConductor, OrdenDespachoDetalle.IdPedidoMySql AS Pedido, Vehiculos.Placa, PedidoWebEncabezado.email,PedidoWebEncabezado.QuienRecibe, PedidoWebEncabezado.DireccionEnvio AS Direccion, PedidoWebEncabezado.Telf1Envio AS Celular, PedidoWebEncabezado.RIFCedEnvio AS Cedula"

      Sql = Sql & " FROM ((OrdenDespacho INNER JOIN OrdenDespachoDetalle ON OrdenDespacho.IdOrdenDespacho = OrdenDespachoDetalle.IdOrdenDespacho) INNER JOIN Vehiculos ON OrdenDespacho.IdVehiculo = Vehiculos.IdVehiculo) INNER JOIN PedidoWebEncabezado ON OrdenDespachoDetalle.IdPedidoMySql = PedidoWebEncabezado.IdPedidoMySql"

      Sql = Sql & " WHERE OrdenDespacho.IdOrdenDespacho = " & Me.vOrden

      Rs.Open Sql, CodeProject.Connection, adOpenStatic, adLockReadOnly

      ' Vehiculo

      Cadena = "" ' Construcción de cadena Json

      Cadena = Cadena & "{'truck_identifier': " & "'" & Nz(Me.IdVehiculo.Column(1)) & "', 'date': " & "'" & Format(Date, "dd-mm-yyyy") & "',"

      Cadena = Cadena & " 'dispatches': ["

      ' Pedido(s)

      Do While Not Rs.EOF

         vPedC = vPedC + 1

         vPed = Rs!IdPedido

         Cadena = Cadena & "{ 'identifier': " & Trim(Rs!Pedido) & ","

         Cadena = Cadena & " 'contact_name': '" & Left(LimpiarBeetrack(Trim(Rs!QuienRecibe)), 250) & "',"

         Cadena = Cadena & " 'contact_address': '" & Left(LimpiarBeetrack(Trim(Rs!Direccion)), 250) & "',"

         Cadena = Cadena & " 'contact_phone': '" & Trim(Rs!Celular) & "',"

         Cadena = Cadena & " 'contact_id': '" & Trim(Rs!Cedula) & "',"

         Cadena = Cadena & " 'contact_email': '" & Trim(Rs!Email) & "',"

         ' Caja(s)

         vTag = Nz(DLookup("Cajas", "PedidoEncabezado", "IdPedido =" & vPed))

         If vTag <> "" Then

            Cadena = Cadena & " 'tags': [{'name': 'Cajas','value': '" & vTag & "'}],"

         End If

         ' Producto(s)

         Sql2 = "SELECT PedidoEncabezado.IdPedidoMySql, Productos.SKU, Productos.DescProducto AS Producto, PedidoDetalle.Cantidad, PedidoDetalle.IdPedidoDetalle"

         Sql2 = Sql2 & " FROM (PedidoEncabezado INNER JOIN PedidoDetalle ON PedidoEncabezado.IdPedido = PedidoDetalle.IdPedido) INNER JOIN Productos ON PedidoDetalle.IdProducto = Productos.IdProducto"

         Sql2 = Sql2 & " WHERE PedidoEncabezado.IdPedidoMySql = '" & Trim(Rs!Pedido) & "'"

         Sql2 = Sql2 & " ORDER BY Productos.DescProducto;"

         RsProd.Open Sql2, CodeProject.Connection, adOpenStatic, adLockReadOnly

         Cadena = Cadena & " 'items': ["

         Do While Not RsProd.EOF

            Cadena = Cadena & "{ 'code': '" & Left(LimpiarBeetrack(Trim(RsProd!SKU)), 30) & "',"

            Cadena = Cadena & " 'description': '" & Left(LimpiarBeetrack(Trim(RsProd!Producto)), 250) & "',"

            Cadena = Cadena & " 'quantity': " & RsProd!Cantidad

            RsProd.MoveNext

            If Not RsProd.EOF Then Cadena = Cadena & "}," Else Cadena = Cadena & "}]"

         Loop

         RsProd.Close

         cmd.CommandText = "Insert Into beetracksms (IdOrdenDespacho,Cliente,IdPedidoMySql,CelularSMS,Zonero,Celular,FechaRegistro,Usuario) Select " & Me.vOrden & ",'" & Left(LimpiarBeetrack(Trim(Rs!QuienRecibe)), 40) & "'," & Rs!Pedido & ",'" & Rs!Celular & "','" & Me.IdConductor.Column(1) & "','" & Nz(Me.IdConductor.Column(3)) & "','" & Now & "','" & Forms![Usuarios Inicio].[Usuarios] & "'"

         cmd.Execute

         gl_var = SysCmd(acSysCmdSetStatus, "Subiendo Beetrack : " & Left(Cadena, 255))

         Rs.MoveNext

         If Not Rs.EOF Then Cadena = Cadena & "}," Else Cadena = Cadena & "}"

      Loop

      Rs.Close

      Cadena = Cadena & "]}"

      Cadena = Replace(Cadena, "'", Chr(34))

      cmd.CommandText = "Insert Into beetrack (html,IdOrdenDespacho,FechaRegistro,Usuario,NroPedidos) Select '" & Cadena & "'," & Me.vOrden & ",'" & Now & "','" & Forms![Usuarios Inicio].[Usuarios] & "'," & vPedC