Skip to content

Instantly share code, notes, and snippets.

@mckneisler
Last active August 27, 2024 17:41
Show Gist options
  • Save mckneisler/4689846baa928770b5cb to your computer and use it in GitHub Desktop.
Save mckneisler/4689846baa928770b5cb to your computer and use it in GitHub Desktop.
QuickBooks Online API Example for VBA
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
This file has been truncated, but you can view the full file.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment