Con un click pasar datos ordenados a una planilla google sheet excel

     Dim http As Object

    Dim url As String

    Dim datos As String

    Dim codigoerlangenold As String ' 02

    Dim codigofabricaaa As String ' 03

    Dim codigoerlangennew As String ' 04

    Dim otroscodigosinn As String ' 05  El codigo de Repuestos Chile + el codigo que ahora viene de INN

    Dim codigospchile As String ' 05,1

    Dim codigoinnfabrica As String ' 05,2

    Dim descripcionn As String ' 06 Descripcion del producto

    Dim codigoclientee As String '07

    Dim clientecortocodcliente As String '07.1

    Dim clienteeee As String ' 08

    Dim clientecorto As String '081

    Dim ordendecompra As String '09

    Dim posordendecompra As String '091

    Dim ocmaspos As String '092

    Dim bzz As String '0100  es el BZ o compra a fabrica

    Dim posbzz As String '0101  es el BZ o compra a fabrica

    Dim bzzmasposbzz As String '0102  es el BZ o compra a fabrica

    

    Dim cantcomprada As String '0110  es el BZ o compra a fabrica

    Dim Fechasolicitadoo As String '0115  es la fecha solicitada   Texto178

    

    Dim historiall As String '0120 es el historial de la compra = cliente:cliente,oc:oc-pos, bz:bz-pos x cantidad fecha

'_______________________________________________________________________________________________________________________________________________________

' 01 es el modelo que esta en el PDV

If IsNull([Forms]![AWVs]![SeguimientoPosManualf3]!MLFB) Or [Forms]![AWVs]![SeguimientoPosManualf3]!MLFB = "" Then

Modelo = ""

Else

Modelo = [Forms]![AWVs]![SeguimientoPosManualf3]!MLFB

End If

'02 Codigo Erlangen antiguo

If IsNull([Forms]![AWVs]![SeguimientoPosManualf3]!CodErlangenOld) Or [Forms]![AWVs]![SeguimientoPosManualf3]!CodErlangenOld = "" Then

codigoerlangenold = ""

Else

codigoerlangenold = [Forms]![AWVs]![SeguimientoPosManualf3]!CodErlangenOld

End If

'03 Codigo de Fabrica

If IsNull([Forms]![AWVs]![SeguimientoPosManualf3]!CodFab) Or [Forms]![AWVs]![SeguimientoPosManualf3]!CodFab = "" Then

codigofabricaaa = ""

Else

codigofabricaaa = [Forms]![AWVs]![SeguimientoPosManualf3]!CodFab

End If

'04 Codigo Erlangen NEW

If IsNull([Forms]![AWVs]![SeguimientoPosManualf3]!CodErlangenNew) Or [Forms]![AWVs]![SeguimientoPosManualf3]!CodErlangenNew = "" Then

codigoerlangennew = ""

Else

codigoerlangennew = [Forms]![AWVs]![SeguimientoPosManualf3]!CodErlangenNew

End If

'05,1 Codigo SP Chile

If IsNull([Forms]![AWVs]![SeguimientoPosManualf3]!Codigo_Spare_Part) Or [Forms]![AWVs]![SeguimientoPosManualf3]!Codigo_Spare_Part = "" Then

codigospchile = ""

Else

codigospchile = "Cod SP Chile:" & [Forms]![AWVs]![SeguimientoPosManualf3]!Codigo_Spare_Part & " "

End If

'05,2 Codigo INN fabrica

If IsNull([Forms]![AWVs]![SeguimientoPosManualf3]!CodINN) Or [Forms]![AWVs]![SeguimientoPosManualf3]!CodINN = "" Then

codigoinnfabrica = ""

Else

codigoinnfabrica = "Cod INN Fab:" & [Forms]![AWVs]![SeguimientoPosManualf3]!CodINN & " "

End If

'05  otroscodigosinn

otroscodigosinn = codigospchile & codigoinnfabrica

'06 Descripción

If IsNull([Forms]![AWVs]![SeguimientoPosManualf3]!DescripcionLARCH) Or [Forms]![AWVs]![SeguimientoPosManualf3]!DescripcionLARCH = "" Then

descripcionn = ""

Else

descripcionn = [Forms]![AWVs]![SeguimientoPosManualf3]!DescripcionLARCH

End If

'08 cliente

clienteeee = Me.ClienteAWB_F

On Error Resume Next

clientecorto = DLookup("NombreClienteCorto", _

    "Clientes", "ClienteBase ='" & clienteeee & "'")

On Error GoTo 0

'081

If IsNull(clientecorto) Or clientecorto = "" Then

clientecorto = ""

End If

'07 Codigo Cliente

If IsNull([Forms]![AWVs]![SeguimientoPosManualf3]!CodigoCliente) Or [Forms]![AWVs]![SeguimientoPosManualf3]!CodigoCliente = "" Then

codigoclientee = ""

Else

codigoclientee = [Forms]![AWVs]![SeguimientoPosManualf3]!CodigoCliente

End If

'07.1 Cliente corto y  Codigo Cliente

If IsNull([codigoclientee]) Or codigoclientee = "" Then

clientecortocodcliente = ""

Else

clientecortocodcliente = clientecorto & " " & codigoclientee

End If

'09 Orden de Compra

If IsNull([Forms]![AWVs]![SeguimientoPosManualf3]!OC) Or [Forms]![AWVs]![SeguimientoPosManualf3]!OC = "" Then

ordendecompra = ""

Else

ordendecompra = [Forms]![AWVs]![SeguimientoPosManualf3]!OC

End If

'091 Posicion Orden de Compra

If IsNull([Forms]![AWVs]![SeguimientoPosManualf3]!POS_PDV) Or [Forms]![AWVs]![SeguimientoPosManualf3]!PosOC = "" Then

posordendecompra = ""

Else

posordendecompra = [Forms]![AWVs]![SeguimientoPosManualf3]!POS_PDV

'posordendecompra = "pruebaa"

End If

'092 OC mas Posicion

If IsNull([ordendecompra]) Or ordendecompra = "" Then

ocmaspos = ""

Else

ocmaspos = " oc " & ordendecompra & "-" & posordendecompra

End If

'    Dim  As String '0101  es el BZ o compra a fabrica

'0100 BZ o compra fabrica

If IsNull([Forms]![AWVs]![SeguimientoPosManualf3]!BZ) Or [Forms]![AWVs]![SeguimientoPosManualf3]!BZ = "" Then

bzz = ""

Else

bzz = [Forms]![AWVs]![SeguimientoPosManualf3]!BZ

End If

'0101 Posicion bz o compra a fabrica

If IsNull([Forms]![AWVs]![SeguimientoPosManualf3]!PosBZ) Or [Forms]![AWVs]![SeguimientoPosManualf3]!PosBZ = "" Then

posbzz = ""

Else

posbzz = [Forms]![AWVs]![SeguimientoPosManualf3]!PosBZ

End If

'0102 bz mas posicion

If IsNull([bzz]) Or bzz = "" Then

bzzmasposbzz = ""

Else

bzzmasposbzz = " bz " & bzz & "-" & posbzz

End If

'

'0110 cantidad comprada

If IsNull([Forms]![AWVs]![SeguimientoPosManualf3]!QSolProy) Or [Forms]![AWVs]![SeguimientoPosManualf3]!QSolProy = "" Then

cantcomprada = ""

Else

cantcomprada = " x " & [Forms]![AWVs]![SeguimientoPosManualf3]!QSolProy

End If

'    Dim Fechasolicitadoo As Date '0115  es    Texto178

'0115 la fecha solicitada

If IsNull(Texto178) Or Texto178 = "" Or Texto178 = 0 - 0 - 0 Then

Fechasolicitadoo = ""

Else

Fechasolicitadoo = " F: " & Texto178

End If

historiall = clientecorto & " " & ocmaspos & bzzmasposbzz & cantcomprada & Fechasolicitadoo

    url = "https://script.google.com/macros/s/AKfycbwcviHmP9Mi5rhE_kJ4VjfpdoOgCUBxi5MuXfA8Xwtw1jUL-WU3oglLC_7cSU0zLVMp/exec"

    

               

    datos = "modelo=" & EncodeURL(Modelo) & _

            "&erlangenantiguo=" & EncodeURL(codigoerlangenold) & _

            "&modelofabrica=" & EncodeURL(codigofabricaaa) & _

            "&erlangennuevo=" & EncodeURL(codigoerlangennew) & _

            "&otroscodigosinn=" & EncodeURL(otroscodigosinn) & _

            "&descripcion=" & EncodeURL(descripcionn) & _

            "&codcliente=" & EncodeURL(clientecortocodcliente) & _

            "&historial=" & EncodeURL(historiall)

'            "historial=" & EncodeURL(CodClientee)

    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")

    http.Open "POST", url, False

    http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

    http.send datos

y finalmente en el google sript

se ponen los siguientes datos:

function doPost(e) {

  try {

    var sheet = SpreadsheetApp

      .openById("1wSBpuLrq-3L5JQEsXKIbXvM6HAgPYuVQYobS3zNwC_E")

      .getSheetByName("DATOS");

    var modelo  = e.parameter.modelo;

    var erlangenantiguo = e.parameter.erlangenantiguo;

    var modelofabrica = e.parameter.modelofabrica;

    var erlangennuevo = e.parameter.erlangennuevo;

    var otroscodigosinn  = e.parameter.otroscodigosinn;

    var descripcion = e.parameter.descripcion;

    var codcliente = e.parameter.codcliente;

    var historial = e.parameter.historial;

    var ultimaFila = sheet.getLastRow();

    var fila = (ultimaFila == 0) ? 1 : ultimaFila + 1;

    sheet.getRange(fila, 1, 1, 8).setValues([[

      modelo,

      erlangenantiguo,

      modelofabrica,

      erlangennuevo,

      otroscodigosinn,

      descripcion,

      codcliente,

      historial

   ]]);

    return ContentService.createTextOutput("OK");

  } catch(error) {

    return ContentService.createTextOutput("ERROR: " + error.toString());

  }

}

Para abrir un formulario y agregar un nuevo dato

    DoCmd.OpenForm "NombredelFormulario"

    DoCmd.GoToRecord , , acNewRec

form

Abrir formulario a traves de un Filtro y que se presente como una tabla

 

'que abra el formulario como una tabbla

Dim CONSU As String

 CONSU = Texto245

'DoCmd.OpenForm "RDMsQF", acFormDS, , "IDSEG IN(" & Consu & ")", acFormPropertySettings, acIcon

DoCmd.OpenForm "RDMsQF", acFormDS, , "(" & "RDM=" & """" & CONSU & """" & ")", acFormPropertySettings, acIcon

RDMsQF  es el nombre del formulario

RDM es el dato que se rescata a travez de la celda Texto245

y es el dato    que se filtrará en el formulario cuando se abra

'con ID

 Dim CONSU As String

 CONSU = Me.List2.Column(1)

DoCmd.OpenForm "SeguimientoPEMO", acNormal, , "NsegP IN(" & CONSU & ")"

'con dato string

Dim CONSU As String

 CONSU = List2.Column(1)

DoCmd.OpenForm "AWVs", acNormal, , "(" & "AWV=" & """" & CONSU & """" & ")"

 =DBúsq("ValorTC";"TClink";"TC = ""ZCLP""")

=DBúsq("FechaTC";"TClink";"TC = ""USD""")

TClink es el nombre de la Tabla

ValorTC  y FechaTC,  es el valor de la Columna que queremos rescatar

TC es el nombre de la columna que queremos comparar con el dato

ZCLP y USD es un string que evaluaremos si existe en TC

=DBúsq("CodigoSAPCliente";"Clientes";"ClienteBase = Texto47")

Texto47 es una celda en el formulario

=DBúsq("Vendedor";"ClienteVendedorQ";"ClienteBase = Texto47")

Trabajando con mensajes

 Hay una forma muy facil de hacer un mensaje

Msgbox "Escribir el Mensaje"

y listo.

Ahora se puede hacer un mensaje mas elaborado, dando a elegir 2 opciones y tambien agregar la criticidad

al mensaje:

Dim Mensaje, Estilo, Título, Ayuda, Ctxt, Respuesta, MiCadena

Mensaje = "ANTES DE CREAR NUEVO SEGUIMIENTO," & vbCrLf _

& "REVISAR BASE DE DATOS E INFORMACION CRUZADA CON SAP," & vbCrLf _

& "PARA NO REPETIR DATOS.    " & vbCrLf & vbCrLf _

& "¿DESEA SEGUIR Y AGREGAR NUEVO SEGUIMIENTO MANUAL ?"

Estilo = vbYesNo + vbCritical + vbDefaultButton2

Título = "AGREGARÁ NUEVO SEGUIMIENTO MANUAL !"

Ayuda = "DEMO.HLP"    ' Define el archivo de ayuda.

Ctxt = 1000    ' Define el tema

                ' el contexto

                ' Muestra el mensaje.

Respuesta = MsgBox(Mensaje, Estilo, Título, Ayuda, Ctxt)

If Respuesta = vbYes Then    ' El usuario eligió el botón Sí.

On Error GoTo Err_Command520_Click

DoCmd.OpenForm "SeguimientoManualF2"

    DoCmd.GoToRecord , , acNewRec

Exit_Command520_Click:

    Exit Sub

Err_Command520_Click:

    MsgBox Err.Description

    Resume Exit_Command520_Click

Else    ' El usuario eligió el botón No.

    MiCadena = "No"    ' Ejecuta una acción.

End If

Los niveles de criticidad son el dibujo rojo que aparece en la figura

este sería Critico vbCritical 

este sería de pregunta vbQuestion

y este sería de exclamacion vbExclamation

Resetear un dato Autonumerico

 Cuando tenemos una tabla no vinculada y que recibe los datos,

normalmente se tiene que borrar y cargar nuevamente los datos

pero el dato Autonumerico, igual se va incrementando.

entonces la idea sería, resetear este valor a 0, para que nuevamente el primer dato sea 1 luego 2 etc.

En este ejemplo la tabla se llama Files y el Autonumerico se llama FileID:

CurrentDb.Execute "ALTER TABLE Files ALTER COLUMN FileID COUNTER(1,1)"

Borrar y dejar en blanco una tabla que recibe datos

 Lo primero es borrar todos los datos

tabla1  es el nombre de la tabla

PRECAUCION  BORRARÄ TODOS LOS DATOS DE LA TABLA, SIN AVISO:

    DoCmd.SetWarnings False

    strSQL = "Delete * From [tabla1]"

    DoCmd.RunSQL strSQL

    DoCmd.SetWarnings True