QuickBooks Online API Example for VBA

QuickBooksOnline Code.txt

Public Function quote(sString As String) As String
    quote = Chr(34) + sString + Chr(34)
End Function

Public Function URLEncode(sString As String) As String
  Dim iLen As Integer
  iLen = Len(sString)

  If iLen > 0 Then
    ReDim sResult(iLen) As String
    Dim i, iCode As Integer
    Dim sChar, sSpace As String

    sSpace = "%20"

    For i = 1 To iLen
      sChar = Mid$(sString, i, 1)
      iCode = asc(sChar)
      Select Case iCode
        Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
          sResult(i) = sChar
        Case 32
          sResult(i) = sSpace
        Case 0 To 15
          sResult(i) = "%0" & Hex(iCode)
        Case Else
          sResult(i) = "%" & Hex(iCode)
      End Select
    Next i
    URLEncode = Join(sResult, "")
  End If
End Function

Private Function Base64Encode(ByRef bBytesArr() As Byte) As String
    Dim objXML As MSXML2.DOMDocument
    Dim objNode As MSXML2.IXMLDOMElement

    Set objXML = New MSXML2.DOMDocument

    ' byte array to base64
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    objNode.nodeTypedValue = bBytesArr
    Base64Encode = objNode.text

    Set objNode = Nothing
    Set objXML = Nothing
End Function

Public Function HMACSHA1(ByVal sText As String, ByVal sConsumerKey As String)
    Dim oAscii As Object, oEncode As Object
    Dim bTextArr() As Byte
    Dim bKeyArr() As Byte
    Set oAscii = CreateObject("System.Text.UTF8Encoding")
    Set oEncode = CreateObject("System.Security.Cryptography.HMACSHA1")

    bTextArr = oAscii.Getbytes_4(sText)
    bKeyArr = oAscii.Getbytes_4(sConsumerKey)
    oEncode.key = bKeyArr

    Dim bBytesArr() As Byte
    bBytesArr = oEncode.ComputeHash_2((bTextArr))
    HMACSHA1 = Base64Encode(bBytesArr)
    
    Set oAscii = Nothing
    Set oEncode = Nothing
End Function
     
Public Function CreateSignature(ByVal sMethod As String, ByVal sURL As String, ByVal sParams As String, ByVal sKey As String) As String
    Dim sSigText As String

    sSigText = UCase(sMethod) + "&" + URLEncode(sURL) + "&" + URLEncode(sParams)
    CreateSignature = HMACSHA1(sSigText, sKey)
End Function

Private Sub cmdExecute_Click()
    Dim oIE As InternetExplorerMedium
    Dim oHTML As HTMLDocument
    Dim oNodeList As IHTMLElementCollection
    Dim oBody As HTMLObjectElement
    Dim oHTTP As XMLHTTP
    
    Dim sRequestTokenURL As String
    Dim sAccessTokenURL As String
    Dim sURL As String
    Dim sQuery As String
    Dim sCompanyId As String
    Dim sParamListArr() As String
    Dim sParamArr() As String
    Dim sParam As String
    Dim sParams As String
    Dim sCallback As String
    Dim sCallbackEncode As String
    Dim sConsumerKey As String
    Dim sNonce As String
    Dim sSigMethod As String
    Dim sTimestamp As String
    Dim sVersion As String
    Dim sConsumerSecret As String
    Dim sSignature As String
    Dim sRequestToken As String
    Dim sRequestTokenSecret As String
    Dim sVerifier As String
    Dim sAccessToken As String
    Dim sAccessTokenSecret As String
    Dim sXMLText As String
    
    sRequestTokenURL = "https://oauth.intuit.com/oauth/v1/get_request_token"
    sAccessTokenURL = "https://oauth.intuit.com/oauth/v1/get_access_token"
    sAPIBaseURL = "https://sandbox-quickbooks.api.intuit.com/v3/"
    sCallback = "https://example.com"
    sCallbackEncode = URLEncode(sCallback)
    ' Demo for Community Forum Example
    sConsumerKey = "qyprds0jx2k6711GfKSpPDBCNtzu7A"
    sConsumerSecret = "AGVRRkJ0HeWxKGmqcn0imtlWmLe1wjLrL2VHM257"
    sSigMethod = "HMAC-SHA1"
    sVersion = "1.0"
    
' Get Request Token and Secret
    sTimestamp = DateDiff("s", #1/1/1970#, Now())
    sNonce = CStr(CDbl(DateDiff("s", #1/1/1970#, Now())) * 1000 + Format(Now(), "ms"))
    
    sParams = "oauth_callback=" + sCallbackEncode
    sParams = sParams + "&oauth_consumer_key=" + sConsumerKey
    sParams = sParams + "&oauth_nonce=" + sNonce
    sParams = sParams + "&oauth_signature_method=" + sSigMethod
    sParams = sParams + "&oauth_timestamp=" + sTimestamp
    sParams = sParams + "&oauth_version=" + sVersion
    
    sSignature = CreateSignature("GET", sRequestTokenURL, sParams, sConsumerSecret + "&")
    
    sURL = sRequestTokenURL + "?" + sParams + "&oauth_signature=" + URLEncode(sSignature)
    
    Set oIE = New InternetExplorerMedium
    oIE.Visible = False
    oIE.navigate sURL
    Do While oIE.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
    Set oHTML = oIE.Document
    MsgBox oHTML.body.innerText, vbInformation, "Get Request Token and Secret Response"
    
    Set oNodeList = oHTML.getElementsByTagName("body")
    Set oBody = oNodeList.Item(0)
    
    sParamListArr = Split(oBody.textContent, "&")
    oIE.Quit
    Set oIE = Nothing
    
    For i = LBound(sParamListArr) To UBound(sParamListArr)
        sParamArr = Split(sParamListArr(i), "=")
        Select Case sParamArr(0)
            Case "oauth_token"
                sRequestToken = sParamArr(1)
            Case "oauth_token_secret"
                sRequestTokenSecret = sParamArr(1)
        End Select
    Next
    
' Get Company Id and Verifier
    Set oIE = New InternetExplorerMedium
    oIE.Visible = True
    oIE.navigate "https://appcenter.intuit.com/Connect/Begin?oauth_token=" + sRequestToken
    Do While oIE.ReadyState <> READYSTATE_COMPLETE Or Left(oIE.LocationURL, Len(sCallback)) <> sCallback
        DoEvents
    Loop
    Set oHTML = oIE.Document
    sParam = oIE.LocationURL

    sParamListArr = Split(oIE.LocationURL, "?")
    oIE.Quit
    Set oIE = Nothing
    MsgBox sParamListArr(1), vbInformation, "Get Company Id and Verifier Response"
    sParamListArr = Split(sParamListArr(1), "&")
    
    For i = LBound(sParamListArr) To UBound(sParamListArr)
        sParamArr = Split(sParamListArr(i), "=")
        Select Case sParamArr(0)
            Case "realmId"
                sCompanyId = sParamArr(1)
            Case "oauth_verifier"
                sVerifier = sParamArr(1)
        End Select
    Next

' Get Access Token and Secret
    sTimestamp = DateDiff("s", #1/1/1970#, Now())
    sNonce = CStr(CDbl(DateDiff("s", #1/1/1970#, Now())) * 1000 + Format(Now(), "ms"))
    
    sParams = "oauth_consumer_key=" + sConsumerKey
    sParams = sParams + "&oauth_nonce=" + sNonce
    sParams = sParams + "&oauth_signature_method=" + sSigMethod
    sParams = sParams + "&oauth_timestamp=" + sTimestamp
    sParams = sParams + "&oauth_token=" + sRequestToken
    sParams = sParams + "&oauth_verifier=" + sVerifier
    sParams = sParams + "&oauth_version=" + sVersion
    
    sSignature = CreateSignature("GET", sAccessTokenURL, sParams, sConsumerSecret + "&" + sRequestTokenSecret)
    
    sURL = sAccessTokenURL + "?" + sParams + "&oauth_signature=" + URLEncode(sSignature)
    
    Set oIE = New InternetExplorerMedium
    oIE.Visible = False
    oIE.navigate sURL
    Do While oIE.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
    Set oHTML = oIE.Document
    MsgBox oHTML.body.innerText, vbInformation, "Get Access Token and Secret Response"
    
    Set oNodeList = oHTML.getElementsByTagName("body")
    Set oBody = oNodeList.Item(0)
    
    sParamListArr = Split(oBody.textContent, "&")
    oIE.Quit
    Set oIE = Nothing
    
    For i = LBound(sParamListArr) To UBound(sParamListArr)
        sParamArr = Split(sParamListArr(i), "=")
        Select Case sParamArr(0)
            Case "oauth_token"
                sAccessToken = sParamArr(1)
            Case "oauth_token_secret"
                sAccessTokenSecret = sParamArr(1)
        End Select
    Next
    
' Read Company Information
    sTimestamp = DateDiff("s", #1/1/1970#, Now())
    sNonce = CStr(CDbl(DateDiff("s", #1/1/1970#, Now())) * 1000 + Format(Now(), "ms"))
    
    sParams = "oauth_consumer_key=" + sConsumerKey
    sParams = sParams + "&oauth_nonce=" + sNonce
    sParams = sParams + "&oauth_signature_method=" + sSigMethod
    sParams = sParams + "&oauth_timestamp=" + sTimestamp
    sParams = sParams + "&oauth_token=" + sAccessToken
    sParams = sParams + "&oauth_version=" + sVersion

    sURL = sAPIBaseURL + "company/" + sCompanyId + "/companyinfo/" + sCompanyId
    
    sSignature = CreateSignature("GET", sURL, sParams, sConsumerSecret + "&" + sAccessTokenSecret)
    
    sParams = "OAuth "
    sParams = sParams + "oauth_consumer_key=" + quote(sConsumerKey) + ","
    sParams = sParams + "oauth_nonce=" + quote(sNonce) + ","
    sParams = sParams + "oauth_signature_method=" + quote(sSigMethod) + ","
    sParams = sParams + "oauth_timestamp=" + quote(sTimestamp) + ","
    sParams = sParams + "oauth_token=" + quote(sAccessToken) + ","
    sParams = sParams + "oauth_version=" + quote(sVersion) + ","
    sParams = sParams + "oauth_signature=" + quote(URLEncode(sSignature))

    Set oHTTP = New XMLHTTP
    oHTTP.Open "GET", sURL, False
    oHTTP.setRequestHeader "Accept", "application/xml"
    oHTTP.setRequestHeader "Authorization", sParams
    oHTTP.send

    Do While oHTTP.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
    
    MsgBox oHTTP.responseText, vbInformation, "Read Company Information Response"
    Set oHTTP = Nothing

' Read Filtered Item List
    sTimestamp = DateDiff("s", #1/1/1970#, Now())
    sNonce = CStr(CDbl(DateDiff("s", #1/1/1970#, Now())) * 1000 + Format(Now(), "ms"))
    
    sQuery = "select * from Item where name like 'Test%' orderby name desc maxresults 1"
    
    sParams = "oauth_consumer_key=" + sConsumerKey
    sParams = sParams + "&oauth_nonce=" + sNonce
    sParams = sParams + "&oauth_signature_method=" + sSigMethod
    sParams = sParams + "&oauth_timestamp=" + sTimestamp
    sParams = sParams + "&oauth_token=" + sAccessToken
    sParams = sParams + "&oauth_version=" + sVersion
    sParams = sParams + "&query=" + URLEncode(sQuery)

    sURL = sAPIBaseURL + "company/" + sCompanyId + "/query"
    
    sSignature = CreateSignature("GET", sURL, sParams, sConsumerSecret + "&" + sAccessTokenSecret)
    
    sURL = sURL + "?query=" + URLEncode(sQuery)
    
    sParams = "OAuth "
    sParams = sParams + "oauth_consumer_key=" + quote(sConsumerKey) + ","
    sParams = sParams + "oauth_nonce=" + quote(sNonce) + ","
    sParams = sParams + "oauth_signature_method=" + quote(sSigMethod) + ","
    sParams = sParams + "oauth_timestamp=" + quote(sTimestamp) + ","
    sParams = sParams + "oauth_token=" + quote(sAccessToken) + ","
    sParams = sParams + "oauth_version=" + quote(sVersion) + ","
    sParams = sParams + "oauth_signature=" + quote(URLEncode(sSignature))

    Set oHTTP = New XMLHTTP
    oHTTP.Open "GET", sURL, False
    oHTTP.setRequestHeader "Accept", "application/xml"
    oHTTP.setRequestHeader "Authorization", sParams
    oHTTP.send

    Do While oHTTP.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
    sXMLText = oHTTP.responseText
    MsgBox oHTTP.responseText, vbInformation, "Read Filtered Item List Response"
    Set oHTTP = Nothing
    
    Dim oXML As DOMDocument
    Dim oXMLList As IXMLDOMNodeList
    Dim sTestCount As String
    
    Set oXML = New DOMDocument
    oXML.loadXML (sXMLText)
    Set oXMLList = oXML.getElementsByTagName("Name")
    If oXMLList.length = 0 Then
        sTestCount = "01"
    Else
        sTestCount = Format(CInt(Right(oXMLList.Item(0).text, 2)) + 1, "00")
    End If
    
' Create New Item
    sTimestamp = DateDiff("s", #1/1/1970#, Now())
    sNonce = CStr(CDbl(DateDiff("s", #1/1/1970#, Now())) * 1000 + Format(Now(), "ms"))
    
    sXMLText = "<?xml version=" & quote("1.0") & " encoding=" & quote("UTF-8") & " standalone=" & quote("yes") & "?>"
    sXMLText = sXMLText & "<Item xmlns=" & quote("http://schema.intuit.com/finance/v3") & ">"
    sXMLText = sXMLText & "<Name>Test" & sTestCount & "</Name>"
    sXMLText = sXMLText & "<IncomeAccountRef name=" & quote("Sales of Product Income") & ">79</IncomeAccountRef>"
    sXMLText = sXMLText & "<PurchaseDesc>This is the test description.</PurchaseDesc>"
    sXMLText = sXMLText & "<PurchaseCost>35</PurchaseCost>"
    sXMLText = sXMLText & "<ExpenseAccountRef name=" & quote("Cost of Goods Sold") & ">80</ExpenseAccountRef>"
    sXMLText = sXMLText & "<AssetAccountRef name=" & quote("Inventory Asset-1") & ">81</AssetAccountRef>"
    sXMLText = sXMLText & "<InvStartDate>2015-01-01</InvStartDate>"
    sXMLText = sXMLText & "</Item>"
    
    sParams = "oauth_consumer_key=" + sConsumerKey
    sParams = sParams + "&oauth_nonce=" + sNonce
    sParams = sParams + "&oauth_signature_method=" + sSigMethod
    sParams = sParams + "&oauth_timestamp=" + sTimestamp
    sParams = sParams + "&oauth_token=" + sAccessToken
    sParams = sParams + "&oauth_version=" + sVersion

    sURL = sAPIBaseURL + "company/" + sCompanyId + "/item"
    
    sSignature = CreateSignature("POST", sURL, sParams, sConsumerSecret + "&" + sAccessTokenSecret)
    
    sParams = "OAuth "
    sParams = sParams + "oauth_consumer_key=" + quote(sConsumerKey) + ","
    sParams = sParams + "oauth_nonce=" + quote(sNonce) + ","
    sParams = sParams + "oauth_signature_method=" + quote(sSigMethod) + ","
    sParams = sParams + "oauth_timestamp=" + quote(sTimestamp) + ","
    sParams = sParams + "oauth_token=" + quote(sAccessToken) + ","
    sParams = sParams + "oauth_version=" + quote(sVersion) + ","
    sParams = sParams + "oauth_signature=" + quote(URLEncode(sSignature))

    Set oHTTP = New XMLHTTP
    oHTTP.Open "POST", sURL, False
    oHTTP.setRequestHeader "Accept", "application/xml"
    oHTTP.setRequestHeader "Content-Type", "application/xml"
    oHTTP.setRequestHeader "Authorization", sParams
    oHTTP.send (sXMLText)

    Do While oHTTP.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
    
    MsgBox oHTTP.responseText, vbInformation, "Create New Item Response"
    Set oHTTP = Nothing
End Sub

QuickBooksOnline.accdb