Usando la API REST de QuickBooks a través de VBA – Parte 2

Como segunda parte de mi artículo de API REST de QuickBooks, quería demostrar cómo podemos trabajar con sus datos de QuickBooks y realizar esas operaciones CRUD comunes.

En la Parte 1, repasé el proceso y el código para usar VBA para autenticarme con los puntos finales de QuickBook OAuth y obtener los tokens de acceso necesarios. Si se perdió ese, use el siguiente enlace para revisarlo antes de continuar con este artículo.

Para lo siguiente, voy a trabajar con los clientes de QuickBook, pero el mismo enfoque básico funcionará con cualquier otra ‘tabla’: cuentas, facturas, proveedores, depósitos, estimaciones, inventario, pagos, … es solo una cuestión de usar los puntos finales adecuados para esos datos y construir la consulta apropiada.

Recuperación de información de la empresa

Probablemente lo más fácil de hacer es recuperar datos.

Así es como puede validar la empresa con la que su conexión está conectada/trabajando.

Sub GetCompanyName()
    Dim oHTTP                 As Object
    Dim sAccessToken          As String
    Dim sRealmId              As String
    Dim sEndPoint             As String
    Dim sResponse             As String
    Dim sStatus               As String

    Call OAuth2_AccountInfo_Load
    sRealmId = OAuth2.realm_id
    If Not QB_Token_IsValid Then QB_Token_Refresh
    Call OAuth2_Token_Load
    sAccessToken = OAuth2.access_token

    sEndPoint = " & sRealmId & "/companyinfo/1" & _
                "?" & GenereateCacheBuster()

    'Set oHTTP = CreateObject("MSXML2.XMLHTTP")
    Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    With oHTTP
        .Open "GET", sEndPoint, False
        .setRequestHeader "Authorization", "Bearer " & sAccessToken
        .setRequestHeader "Accept", "application/json"
        .send

        sResponse = .responseText
        sStatus = .Status
    End With

    If sStatus = 200 Then
        Debug.Print "Company Name: " & ParseCompanyName(sResponse)
    Else
        Debug.Print "Error: " & sResponse
    End If

    Set oHTTP = Nothing
End Sub

Function ParseCompanyName(jsonResponse As String) As String
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    
    ' Extract CompanyName from JSON
    regex.Pattern = """CompanyName"":""((^"")+)"""
    If regex.Test(jsonResponse) Then
        ParseCompanyName = regex.Execute(jsonResponse)(0).SubMatches(0)
    Else
        ParseCompanyName = "Not Found"
    End If
End Function

Recuperar la información del cliente

Recupere la información del cliente – Ejemplo 1

El siguiente código ilustra cómo recuperar las 5 entradas de clientes más recientes.

Sub GetLastFiveCustomers()
    Dim oHTTP                 As Object
    Dim sAccessToken          As String
    Dim sRealmId              As String
    Dim sEndPoint             As String
    Dim sQuery                As String
    Dim sResponse             As String
    Dim sStatus               As String

    Call OAuth2_AccountInfo_Load
    sRealmId = OAuth2.realm_id
    If Not QB_Token_IsValid Then QB_Token_Refresh
    Call OAuth2_Token_Load
    sAccessToken = OAuth2.access_token

    sQuery = "SELECT DisplayName FROM Customer ORDERBY MetaData.CreateTime DESC MAXRESULTS 5"
    sEndPoint = " & sRealmId & "/query?query=" & _
                URLEncode(sQuery) & "&" & GenereateCacheBuster()

    Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    With oHTTP
        .Open "GET", sEndPoint, False
        .setRequestHeader "Authorization", "Bearer " & sAccessToken
        .setRequestHeader "Accept", "application/json"
        .send

        sResponse = .responseText
        sStatus = .Status
    End With

    If sStatus = 200 Then
        Debug.Print "Customer Name(s): " & ParseCustomerNames(sResponse)
    Else
        Debug.Print "Error: " & sResponse
    End If

    Set oHTTP = Nothing
End Sub

Function ParseCustomerNames(jsonResponse As String) As String
    Dim regex As Object, matches As Object, match As Object
    Dim customerNames         As String

    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.Pattern = """DisplayName"":""((^"")+)"""

    Set matches = regex.Execute(jsonResponse)
    For Each match In matches
        customerNames = customerNames & match.SubMatches(0) & vbCrLf
    Next match

    ParseCustomerNames = customerNames

    Set matches = Nothing
    Set regex = Nothing
End Function

Como puede ver, todo está controlado por la variable Squery, que es una consulta SQL estándar. ¡Entonces, estamos en territorio familiar! ¡Ahora debe darse cuenta de que podemos recuperar diferentes columnas y aplicar una variedad de condiciones y clasificación con facilidad!

Recupere la información del cliente – Ejemplo 2

¿Qué tal un ejemplo más útil en el que buscamos el registro de un cliente por primer y apellido?

Function FindCustomerByName(ByVal sFirstName As String, _
                            ByVal sLastName As String) As String
    Dim oHTTP                 As Object
    Dim sAccessToken          As String
    Dim sRealmId              As String
    Dim sEndPoint             As String
    Dim sQuery                As String
    Dim sResponse             As String
    Dim sStatus               As String
    Dim oCustomerData         As Object
    Dim lNoMatches            As Long

    Call OAuth2_AccountInfo_Load
    sRealmId = OAuth2.realm_id
    If Not QB_Token_IsValid Then QB_Token_Refresh
    Call OAuth2_Token_Load
    sAccessToken = OAuth2.access_token

    'is not case sensitive
    sQuery = "SELECT Id, GivenName, FamilyName FROM Customer WHERE GivenName="" & sFirstName & "" AND FamilyName="" & sLastName & """
    sEndPoint = " & sRealmId & "/query?query=" & _
                URLEncode(sQuery) & "&" & GenereateCacheBuster()

    Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    With oHTTP
        .Open "GET", sEndPoint, False
        .setRequestHeader "Authorization", "Bearer " & sAccessToken
        .setRequestHeader "Accept", "application/json"
        .send

        sResponse = .responseText
        sStatus = .Status
    End With

    If sStatus = 200 Then
        Set oCustomerData = JsonConverter.ParseJson(sResponse)
        lNoMatches = oCustomerData("QueryResponse")("Customer").Count
        If lNoMatches = 1 Then
            FindCustomerByName = oCustomerData("QueryResponse")("Customer")(1)("Id")
            'Debug.Print "Id: " & oCustomerData("QueryResponse")("Customer")(1)("Id")
        Else
            'We have a problem!
        End If
    Else
        Debug.Print "Error: " & sResponse
    End If

    Set oHTTP = Nothing
End Function

¡Observe los lnomatches! Es fundamental realizar dicha validación que sea posible tener varias personas con los mismos nombres. La forma en que manejas tales situaciones dependería de ti. Puede recorrerlos y permitir que el usuario haga una selección, puede aumentar la función de búsqueda para incluir también el nombre de la compañía u otro identificador único para asegurarse de que no ocurra más de 1 coincidencia, …

Creación de registros de clientes

Crear una entrada también es muy sencilla y el código para hacerlo se vería como:

Sub QB_CreateCustomer()
    Dim oHTTP                 As Object
    Dim sAccessToken          As String
    Dim sRealmId              As String
    Dim sEndPoint             As String
    Dim sRequest              As String
    Dim sResponse             As String
    Dim sStatus               As String

    Call OAuth2_AccountInfo_Load
    sRealmId = OAuth2.realm_id
    If Not QB_Token_IsValid Then QB_Token_Refresh
    Call OAuth2_Token_Load
    sAccessToken = OAuth2.access_token

    sEndPoint = " & sRealmId & "/customer"    'Development
    ' sEndPoint = " & sRealmId & "/customer" 'Production
    sRequest = "{""DisplayName"": ""Adam Apples"", ""PrimaryEmailAddr"": {""Address"": ""test@example.com""}}"

    Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    With oHTTP
        .Open "POST", sEndPoint, False
        .setRequestHeader "Authorization", "Bearer " & sAccessToken
        .setRequestHeader "Content-Type", "application/json"
        .send sRequest

        sResponse = .responseText
        sStatus = .Status
    End With

    If sStatus = 200 Then
        Debug.Print "sResponse: " & sResponse    'Extract the newly create record's Id from the response!!!
    Else
        Debug.Print "Error: " & sResponse
    End If

    Set oHTTP = Nothing
End Sub

Entonces, todo depende de la srequest, que es una cadena formateada JSON que representa el registro del cliente.

Tokens de sincronización!

Antes de poder realizar cambios en los datos (actualizar o eliminar), debe leer el token de sincronización de registros y proporcionar de nuevo a QuickBooks para demostrar que está trabajando con la versión adecuada de los datos. Si su token de sincronización no coincide con el último token de sincronización asociado con el registro que está intentando modificar, la operación no se permitirá y fallará con un error que lo indique.

Los tokens de sincronización actúan como cerraduras optimistas para evitar conflictos. Para actualizaciones y deleciones, se aseguran de que esté trabajando con la última versión de la entidad. Si el token de sincronización no coincide con el estado del servidor actual, la API rechaza la operación con un error de concurrencia.

Lo que esto significa es que antes de poder presionar y actualizar/eliminar primero uno debe recuperar el token de sincronización. Entonces nuestro código se hizo un poco más. ¡Sin embargo, nada que no podamos manejar!

Actualización de registros de clientes

Si quisiéramos actualizar el registro que acabamos de crear anteriormente y agregar un nombre de empresa y actualizar la dirección de correo electrónico asociada, haríamos algo como:

Sub QB_UpdateCustomer()
    Dim sCustomerId           As String
    Dim sEmail                As String
    Dim sCompanyName          As String
    Dim oCustomerData         As Object
    Dim oHTTP                 As Object
    Dim sAccessToken          As String
    Dim sRealmId              As String
    Dim sEndPoint             As String
    Dim sRequest              As String
    Dim sResponse             As String
    Dim sStatus               As String
    Dim sSyncToken            As String

    Call OAuth2_AccountInfo_Load
    sRealmId = OAuth2.realm_id
    If Not QB_Token_IsValid Then QB_Token_Refresh
    Call OAuth2_Token_Load
    sAccessToken = OAuth2.access_token

    sCustomerId = "61"    ' QuickBooks Customer ID (extracted from the previous step)

    ' Retrieve current customer data to get SyncToken
    ' sEndPoint = " & realmId & "/customer/" & customerId
    ' sEndPoint = " & realmId & "/customer/" & customerId
    'cache-busting parameter
    sEndPoint = " & sRealmId & "/customer/" & sCustomerId & _
                "?" & GenereateCacheBuster

    Set oHTTP = CreateObject("MSXML2.XMLHTTP")
    With oHTTP
        .Open "GET", sEndPoint, False
        .setRequestHeader "Authorization", "Bearer " & sAccessToken
        .setRequestHeader "Accept", "application/json"
        .send

        sResponse = .responseText
        sStatus = .Status
    End With

    If sStatus <> 200 Then
        Debug.Print "Failed to retrieve customer: " & sResponse
        Exit Sub
    End If

    ' Retrieve the SyncToken from the response (requires JSON parser like JsonConverter.bas)
    On Error Resume Next
    Set oCustomerData = JsonConverter.ParseJson(sResponse)
    sSyncToken = oCustomerData("Customer")("SyncToken")
    On Error GoTo 0
    Set oCustomerData = Nothing

    If sSyncToken = "" Then
        Debug.Print "Failed to parse SyncToken from customer data"
        Exit Sub
    Else
        Debug.Print "syncToken: " & sSyncToken
    End If

    ' Actually Update the Customer entry
    sResponse = "" 'Reset value as a precaution
    sStatus = "" 'Reset value as a precaution
    sEmail = "updated.email@company.com"
    sCompanyName = "Apple Moving Inc."
    sEndPoint = " & sRealmId & "/customer"    'Development
    ' sEndPoint = " & sRealmId & "/customer" 'Production
    'Update the e-mail address and add a Company Name to the entry
    sRequest = "{""Id"":" & sCustomerId & ",""SyncToken"":" & sSyncToken & ",""PrimaryEmailAddr"":{""Address"":""" & sEmail & """}, ""CompanyName"":""" & sCompanyName & """,""sparse"":true}"

    With oHTTP
        .Open "POST", sEndPoint, False
        .setRequestHeader "Authorization", "Bearer " & sAccessToken
        .setRequestHeader "Content-Type", "application/json; charset=UTF-8"
        .setRequestHeader "Content-Length", Len(sRequest)
                .setRequestHeader "Accept", "application/json"
        '.setRequestHeader "Accept", "application/xml"
        .send sRequest

        sResponse = .responseText
        sStatus = .Status
    End With

    If sStatus = 200 Then
        Debug.Print "Entry updated successfully for Customer ID: " & sCustomerId
        ' Optionally parse and display new SyncToken from response:
        'For a JSON response
        Set oCustomerData = JsonConverter.ParseJson(sResponse)
        Debug.Print "Id: " & oCustomerData("Customer")("Id")
        Debug.Print "DisplayName: " & oCustomerData("Customer")("DisplayName")
        Debug.Print "New SyncToken: " & oCustomerData("Customer")("SyncToken")
        Debug.Print "Active: " & oCustomerData("Customer")("Active")
'        'For XML response
'        Debug.Print "DisplayName: " & ExtractValue(sResponse, "DisplayName")
'        Debug.Print "SyncToken: " & ExtractValue(sResponse, "SyncToken")
'        Debug.Print "Active: " & ExtractValue(sResponse, "Active")
    Else
        Debug.Print "Error " & sStatus & ": " & sResponse
        Exit Sub
    End If

    Set oCustomerData = Nothing
    Set oHTTP = Nothing
End Sub

Como puede ver, estoy utilizando explícitamente la identificación del cliente para poder dirigir el registro adecuado para la actualización. Esto significa que guardo dicha información cuando creo el registro o tengo que buscarlo antes de ejecutar dicha función.

Eliminar un registro del cliente

Hay excepciones, pero en un sentido general, QuickBooks normalmente no elimina realmente los registros, sino que simplemente alterna la columna activa a False. Esto tiene el beneficio adicional de que ningún datos se pierde realmente e incluso nos permite reactivar los registros si es necesario.

A continuación sería el código para ‘eliminar’ a un cliente:

Sub QB_DeleteCustomer()
' There is no deletion, but rather making an entry inactive.
    Dim sCustomerId           As String
    Dim oCustomerData         As Object
    Dim oHTTP                 As Object
    Dim sAccessToken          As String
    Dim sRealmId              As String
    Dim sEndPoint             As String
    Dim sRequest              As String
    Dim sResponse             As String
    Dim sStatus               As String
    Dim sSyncToken            As String

    Call OAuth2_AccountInfo_Load
    sRealmId = OAuth2.realm_id
    If Not QB_Token_IsValid Then QB_Token_Refresh
    Call OAuth2_Token_Load
    sAccessToken = OAuth2.access_token

    sCustomerId = "61"    ' QuickBooks Customer ID (extracted from the previous step)

    ' Retrieve current customer data to get SyncToken
    ' sEndPoint = " & realmId & "/customer/" & customerId
    ' sEndPoint = " & realmId & "/customer/" & customerId
    'cache-busting parameter
    sEndPoint = " & sRealmId & "/customer/" & sCustomerId & _
                "?" & GenereateCacheBuster

    Set oHTTP = CreateObject("MSXML2.XMLHTTP")
    With oHTTP
        .Open "GET", sEndPoint, False
        .setRequestHeader "Authorization", "Bearer " & sAccessToken
        .setRequestHeader "Accept", "application/json"
        .send

        sResponse = .responseText
        sStatus = .Status
    End With

    If sStatus <> 200 Then
        Debug.Print "Failed to retrieve customer: " & sResponse
        Exit Sub
    End If

    ' Retrieve the SyncToken from the response (requires JSON parser like JsonConverter.bas)
    On Error Resume Next
    Set oCustomerData = JsonConverter.ParseJson(sResponse)
    sSyncToken = oCustomerData("Customer")("SyncToken")
    On Error GoTo 0
    Set oCustomerData = Nothing

    If sSyncToken = "" Then
        Debug.Print "Failed to parse SyncToken from customer data"
        Exit Sub
    Else
        Debug.Print "syncToken: " & sSyncToken
    End If

    ' Actually Update the Customer entry
    sResponse = "" 'Reset value as a precaution
    sStatus = "" 'Reset value as a precaution
    sEndPoint = " & sRealmId & "/customer"    'Development
    ' sEndPoint = " & sRealmId & "/customer" 'Production
    ' To Disable the entry
    sRequest = "{" & _
               """Id"": """ & sCustomerId & """," & _
               """SyncToken"": """ & sSyncToken & """," & _
               """Active"": false," & _
               """sparse"": true" & _
               "}"
'    ' To Reenable the entry
'    sRequest = "{" & _
'               """Id"": """ & sCustomerId & """," & _
'               """SyncToken"": """ & sSyncToken & """," & _
'               """Active"": true," & _
'               """sparse"": true" & _
'               "}"

    With oHTTP
        .Open "POST", sEndPoint, False
        .setRequestHeader "Authorization", "Bearer " & sAccessToken
        .setRequestHeader "Content-Type", "application/json" '; charset=UTF-8"
        .setRequestHeader "Content-Length", Len(sRequest)
        .setRequestHeader "Accept", "application/json"
        '.setRequestHeader "Accept", "application/xml"
        .send sRequest

        sResponse = .responseText
        sStatus = .Status
    End With

    If sStatus = 200 Then
        Debug.Print "Entry updated successfully for Customer ID: " & sCustomerId
        ' Optionally parse and display new SyncToken from response:
        'On Error Resume Next
        'Debug.Print sResponse
        'For a JSON response
        Set oCustomerData = JsonConverter.ParseJson(sResponse)
        Debug.Print "Id: " & oCustomerData("Customer")("Id")
        Debug.Print "DisplayName: " & oCustomerData("Customer")("DisplayName")
        Debug.Print "New SyncToken: " & oCustomerData("Customer")("SyncToken")
        Debug.Print "Active: " & oCustomerData("Customer")("Active")
'        'For XML response
'        Debug.Print "DisplayName: " & ExtractValue(sResponse, "DisplayName")
'        Debug.Print "SyncToken: " & ExtractValue(sResponse, "SyncToken")
'        Debug.Print "Active: " & ExtractValue(sResponse, "Active")
    Else
        Debug.Print "Error " & sStatus & ": " & sResponse
        Exit Sub
    End If

    Set oCustomerData = Nothing
    Set oHTTP = Nothing
End Sub

También observe que también proporcioné el Código/JSON para reactivar la entrada (es simplemente una cuestión de cambiar el falso a verdadero).

¡Eso es todo lo que ella escribió!

Bueno, esa es mi gira por implementar la API REST QuickBooks en VBA. Ahora sabe cómo superar el proceso de autenticación y luego realizar operaciones CRUD en los datos de su empresa desde cualquier aplicación VBA de su elección (Access, Excel, …). ¡Así que no hay mucho que no puedas hacer!

Espero que estos tutoriales de API REST hayan ayudado a iluminarlo sobre cómo se pueden implementar y cómo todos son de naturaleza muy similar. Entonces, si puede obtener uno funcional, básicamente puede hacer que todos los demás trabajen de manera similar.

(RESTFOR) API abren un nuevo reino de posibilidades a VBA, ya que puede integrar con un amplio sistema de variedades en línea como:

• Microsoft Graph (correos electrónicos, contactos, calendarios, …)
• Google (Gmail, Calendario, Docs, …)
• Sistemas CRM (Twillo, …)
• Redes sociales (Facebook, LinkedIn, Instagram, Tiktok, …)
• Finanzas (Yahoo Finance, Alpha Vantage)
• Aplicaciones financieras (QuickBooks, Xero, …)
• Procesamiento de pagos (Stripe, Moneris, PayPal, Square …)
• Unidades en línea (Dropbox, OneDrive, Google, …)
• Clima
• Geolocalización
• Mapeo (Google, ArcGIS, OpenStreetMaps, …)
• Chatbots
• Marketing de correo electrónico (MailChimp, SendGrid, …)
• Mensajes de texto, mensajería (Twillo, Raange, …)
• ¡Tantos más!

¡No pase por alto el hecho de que también puede crear su propia API REST para extender sus propios sistemas!

Algunos recursos sobre el tema