Hi,
I made several API connections in Excel with VBA to GET deal information, perform searches etc. Then I started to create a function to update deal data with a PUT request. Could not get it to work but then again, I am not particularily good with VBA/API/JSON, either. I found a solution that works for me and Pipedrive support contact asked me to share this here in case someone else needs to do something similar. The comments are in Estonian, I will try to translate them as well:
Sub pipedrive_save_data()
'***ERRORHANDLER*****
On Error GoTo ErrMsg
'********************
Dim ws As Worksheet
Set ws = Sheets("ver")
Dim company_domain As String
company_domain = "" 'Enter your company domain, that is the bit before .pipedrive.com
Dim data_field_api_key As String
data_field_api_key = "76cdc98828ab2ada0abd194c1648965274bc9d13"
' ***********
' * *
' * GET *
' * *
' ***********
'CREATE THE HTTP GET REQUEST URL
Dim dealUrl As String
dealUrl = "https://" & company_domain & ".pipedrive.com/v1/deals/" & ws.[pd_deal_id] & "?api_token=" & ws.[pd_your_api_token]
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
http.Open "GET", dealUrl, False
http.Send
'Download data for the existing deal
Dim Json As Object
Set Json = JsonConverter.ParseJson(http.ResponseText)
' ************
' * *
' * DATA *
' * *
' ************
Dim read_data As String
Dim read_title As String
Dim read_value As String
Dim read_cost As String
read_data = Json("data")(data_field_api_key)
read_title = Json("data")("title")
read_value = Json("data")("value")
read_cost = Json("data")("35fea30d6dc6861a79cc514ef48ffb1f5929dc35")
Dim write_data As String
Dim write_title As String
Dim write_value As String
Dim write_cost As String
write_data = ws.[pd_deal_data].Value
write_title = ws.[projectname].Value
write_value = ws.[pd_deal_price].Value
write_cost = ws.[pd_deal_cost].Value
'Create the new JSON structure
Dim Json_body As New Dictionary
Set Json_body = JsonConverter.ParseJson("{""76cdc98828ab2ada0abd194c1648965274bc9d13"":"""",""title"":"""",""value"":"""",""35fea30d6dc6861a79cc514ef48ffb1f5929dc35"":""""}")
Json_body(data_field_api_key) = write_data
Json_body("title") = write_title
Json_body("value") = write_value
Json_body("35fea30d6dc6861a79cc514ef48ffb1f5929dc35") = write_cost
'Ask if the user is sure before proceeding
If MsgBox("Nimi: " & read_title & " => " & write_title & Chr(10) & "Hind: " & read_value & " => " & write_value & Chr(10) & "Omahind: " & read_cost & " => " & write_cost & Chr(10) & "Andmed: " & read_data & " => " & write_data, vbYesNo, "Overwrite data?") = vbYes Then
' ***********
' * *
' * PUT *
' * *
' ***********
'Send JSON to Pipedrive
Dim response_put As String
http.Open "PUT", dealUrl, False
http.SetRequestHeader "Content-Type", "application/json"
http.Send (JsonConverter.ConvertToJson(Json_body, Whitespace:=2))
response_put = http.ResponseText
Debug.Print response_put
MsgBox ("Data saved successfully!")
End If
'***ERRORHANDLER*****
Exit Sub
ErrMsg:
Application.Cursor = xlDefault
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox ("There is an error with pipedrive_save_data!"), , "ERROR"
'********************
End Sub
If anyone has suggestions to better this code, please feel free to let me know. I am sure there could be more if-else type of error handlers etc but at the moment the code does what it is supposed to do for me so I’ll let it be for the time being.
Note that this code uses the VBA-JSON tool from GitHub to parse JSON: LINK