-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy patha_SmartSheetTools.bas
447 lines (382 loc) · 17.8 KB
/
a_SmartSheetTools.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
' ======================================================================================================================================================================
' **Smart Sheet Tools**
' Version 1.2
Public Function SmartSheetToolsVersion() As String
Debug.Print ("1.2")
SmartSheetToolsVersion = "1.2"
End Function
' Tools and generalized functions to help with using VBA to talk directly to SmartSheet & and it's API
'
' Code Written by Aaron Fisher of FishcoDesign
'
' Utilizing :
' VBA-Web 4.0.20 library from : https://github.com/VBA-tools
' VBA-Jason 2.0.1 library from : https://github.com/VBA-tools/VBA-JSON
' SmartSheet API 2.0 : http://smartsheet-platform.github.io/api-docs
' ======================================================================================================================================================================
'
Public Function SmartSheetGet(Request As String, Optional CustomToken As String = "1") As WebResponse
' =======================================================================================
' This will perform a HTTP Get request and return an Unparsed WebResponse from the
' SmartSheet API. The Request should be in the format of what comes AFTER the SmartSheet
' Base URL (https://api.smartsheet.com/2.0/). See the SmartSheet API for more information
' =======================================================================================
'
' Check for sync disable and setup API_Token
If CustomToken = "1" Then
API_Token = Range("API_Token")
Else:
API_Token = CustomToken
End If
If Range("Sync_Disabled") = "TRUE" Then
boxResponse = MsgBox("SmartSheet Syncing is disabled", vbCritical, "SmartSheetSync Disabled")
End
End If
' Setup SmartSheet as a WebClient, setup Authentication & Proxy Stuff, and assign Base URL
Dim SmartSheet As New WebClient
Dim Options As New Dictionary
SmartSheet.BaseUrl = "https://api.smartsheet.com/2.0/" ' Set Base URl
SmartSheet.EnableAutoProxy = True ' Get Proxy Stuff
Dim Response As WebResponse
Dim Headers As New Collection
Set Response = SmartSheet.GetJson(Request)
Headers.Add WebHelpers.CreateKeyValue("Authorization", "Bearer " & API_Token) ' Add Authentication Header
Options.Add "Headers", Headers
Set Response = SmartSheet.GetJson(Request, Options)
' Return SmartSheet JSON File as Object
If Response.StatusCode = WebStatusCode.Ok Then
Set SmartSheetGet = Response
Else
boxResponse = MsgBox("Error!" & Chr(10) & _
"Status Code : " & Response.StatusCode & Chr(10) & _
"Code Description : " & Response.StatusDescription & Chr(10) & _
"Content : " & Response.Content, vbCritical, "Error!")
Debug.Print "Error!"
Debug.Print Response.StatusCode
Debug.Print Response.StatusDescription
Debug.Print Response.Content
End
End If
End Function
Public Function BuildDictionary(WebResponse As WebResponse) As Scripting.Dictionary
' =======================================================================================
' Pass a WebResponse from SmartSheet into this function from the form /sheets/{sheetID}
' This function will return a Scripting.Dictionary. You can utilize it by calling
' the row number or row Id and then the cell Column Name or Column ID
' Ex :
'
' Dim APIReturn As WebResponse this is the Sheet ID
' Set APIReturn = a_SmartSheetTools.SmartSheetGet("sheets/ 8944216010188676")
' Set theDictionary = a_SmartSheetTools.BuildDictionary(APIReturn)
' *this is the row ID* *This is the column name*
' Debug.Print (theDictionary ("8455186625652612") ("Version"))
' -or- *this is the row number* *this is the column ID number*
' Debug.Print (theDictionary (1) ("4873887012939652"))
'
' You can use any combination of the methods above
' =======================================================================================
Dim APIData As Object
Set APIData = WebHelpers.ParseJson(WebResponse.Content)
Dim Row As Dictionary
Dim Cell As Dictionary
Set columnNames = CreateObject("Scripting.Dictionary")
' Save column names with columnId
For Each Column In APIData("columns")
columnNames.Add Column("id"), Column("title")
Next
' Create Dictionary to hold all the rows and their contents
Set allrows = CreateObject("Scripting.Dictionary")
For Each Row In APIData("rows")
' allrows.Add "zrowId", Row("rowID")
' allrows.Add "znumber", Row("rowNumber")
' Create Dictionary to hold row contents
Set rowcontents = CreateObject("Scripting.Dictionary")
rowcontents.Add "topLevel", Row
For Each Cell In Row("cells")
' Add entry with columnId associated with the value
rowcontents.Add Cell("columnId"), Cell("value")
' Get the column Name
colName = columnNames(Cell("columnId"))
' Add entry with column Name associated with the value
rowcontents.Add colName, Cell("value")
Next Cell
' Add row to allRows Dictionary by rowID
allrows.Add Row("id"), rowcontents
' Add row to allRows Dictionary by rowNumber
allrows.Add Row("rowNumber"), rowcontents
Next Row
Set BuildDictionary = allrows
End Function
Public Function CountData(ColumnName As String, RawData As WebResponse) As Scripting.Dictionary
' =======================================================================================
' This function will parse the RawData WebResponse (obtained from SmartSheetGet) and
' will return as a Dictionary with all of the unique values in the ColumnName as keys
' and the counts of those values as the value. Used for charts and the like.
' =======================================================================================
'
' Double check to make sure the data is loaded
If RawData Is Nothing Then
Debug.Print ("Data Not Loaded")
' Uncomment the 3 lines below for Production
' boxResponse = MsgBox("Data Not Loaded", vbCritical, "Data Not Loaded!")
' formUpdateData.Show
' End
End If
' Parse Data
Dim Parsed As Object
Set Parsed = WebHelpers.ParseJson(RawData.Content)
' Build Dictionary for Column Names
Set colNames = CreateObject("Scripting.Dictionary")
Set ParsedCols = Parsed("columns")
For Each col In ParsedCols
colNames.Add col("title"), col("id")
Next
' Setup Dictionaries to hold counted values
Set colCounts = CreateObject("Scripting.Dictionary")
' Get into each Row
Set ParsedRows = Parsed("rows")
For Each r In ParsedRows
Debug.Print ("Row ID : " & r("id"))
Debug.Print ("Row Number : " & r("rowNumber"))
For Each C In r("cells")
' Count values in column and assign to colCounts Dictionary
' If a new value is found a new key will be created
If C("columnId") = colNames(ColumnName) Then
If colCounts.Exists(C("value")) Then
colCounts.Item(C("value")) = colCounts.Item(C("value")) + 1
Else
colCounts.Add C("value"), 1
End If
End If
Next
Next
' You may disable the For Next segment below for Production
For Each Line In colCounts
Debug.Print (Line & " : " & colCounts(Line))
Next
Set CountData = colCounts
End Function
Public Function CheckForNewVersion(FileName As String)
' ===============================================================================================
' This function will access the File Repository SmartSheet and check to see if there is a newer
' version of FileName than the current version on the PC. It will also automatically check to
' make sure this Workbook is using the latest version of SmartSheetTools. Will return TRUE if
' a new version of either file is available, FALSE if this is the current version.
' ===============================================================================================
Dim currentVersion As Single
Dim APIReturn As WebResponse
Set APIReturn = a_SmartSheetTools.SmartSheetGet("sheets/8944216010188676")
Set repoRows = a_SmartSheetTools.BuildDictionary(APIReturn)
' Check to see if filename matches actual File Name on PC
If Not FileName = ThisWorkbook.Name Then
boxResponse = MsgBox("You have renamed this file from it's default name. This could cause problems. Please close and rename this file as " & FileName & Chr(10) & ". This Workbook will close when you click OK.", vbCritical, "File Name Error")
ThisWorkbook.Close
End
End If
For Each Row In repoRows
' Check current file version
If repoRows(Row)("Current Version") = True And repoRows(Row)("File Name") = FileName Then
currentVersion = repoRows(Row)("Version")
Debug.Print ("Current Version of " & FileName & " : " & currentVersion)
CheckForNewVersion = currentVersion
End If
' Check SmartSheetTools version
If repoRows(Row)("Current Version") = True And repoRows(Row)("File Name") = "SmartSheetTools" Then
currentSmartSheetTools = repoRows(Row)("Version")
Debug.Print ("Current SmartSheetToolsVersion : " & currentSmartSheetTools)
If currentSmartSheetTools > a_SmartSheetTools.SmartSheetToolsVersion Then
boxResponse = MsgBox("Your SmartSheetTools is out of date. Download and import the latest version from the SmartSheet File Repository and import into this workbook. Ask Aaron Fisher if you need help.", vbCritical, "SmartSheetTools Out of Date!")
End If
End If
Next Row
End Function
Public Function RowPost(ByVal Cells As Scripting.Dictionary, Optional Location As String = "toBottom", Optional rowID As String = "", Optional CustomToken As String = "1")
' This will post a Row to SmartSheet. Please note that the Cells Dictionary that is passed must be in the format
' listed below: Column ID # Value
' myCells.Add "3106015123138436", "OEM"
' myCells.Add "5357814936823684", "O137"
' Check for sync disable and setup API_Token
If CustomToken = "1" Then
API_Token = Range("API_Token")
Else:
API_Token = CustomToken
End If
If Range("Sync_Disabled") = "TRUE" Then
boxResponse = MsgBox("SmartSheet Syncing is disabled", vbCritical, "SmartSheetSync Disabled")
End
End If
' Setup Client
Dim SmartSheet As New WebClient
SmartSheet.BaseUrl = "https://api.smartsheet.com/2.0/"
SmartSheet.EnableAutoProxy = True
' Setup Request
'Grab SSID
SheetID = Cells("ssid")
Dim PostRequest As New WebRequest
PostRequest.Resource = "sheets/{sID}/rows"
If rowID = "" Or rowID = "False" Then
PostRequest.Method = WebMethod.HTTPpost
Debug.Print ("using POST")
Else
PostRequest.Method = WebMethod.HttpPut
Debug.Print ("using PUT")
End If
PostRequest.AddUrlSegment "sID", SheetID
PostRequest.Format = WebFormat.JSON ' This handles the content-type Header and all the other necessary JSON stuff
PostRequest.AddHeader "Authorization", "Bearer " & API_Token
' Build String from Dictionary
Dim bodyString As String
' Setup the beginning of the bodyString
If rowID = "" Then
bodyString = "{""" & Location & """:true, ""cells"": ["
Else:
bodyString = "{""id"": """ & rowID & """, """ & Location & """:true, ""cells"": ["
End If
firstOne = True
'{"toTop":true, "cells": [{"columnId": 3106015123138436, "value" : "OEM"}, {"columnId": 5357814936823684, "value" : "O137"}, {"columnId": 5200324928530308, "value" : "Bitcoin mining chip"}, {"columnId": 2865909271422852, "value" : ""}, {"columnId": 2402327681361796, "value" : ""}]}]
' Build the cells portion
For Each C In Cells
If C <> "ssid" Then
If firstOne = True Then
bodyString = bodyString & "{""columnId"": """ & C & """, ""value"" : """ & Cells(C) & """}"
firstOne = False
Else:
bodyString = bodyString & ", {""columnId"": """ & C & """, ""value"" : """ & Cells(C) & """}"
End If
End If
Next
' Finish off the body string
bodyString = bodyString & "]}]"
Debug.Print (bodyString)
' Set bodyString as the Body
PostRequest.Body = bodyString
Dim Response As WebResponse
Set Response = SmartSheet.Execute(PostRequest)
Set RowPost = Response
End Function
Public Function ColIDByName(APIResponse As Object, ColumnName As String)
Set APIData = JsonConverter.ParseJson(APIResponse.Content)
For Each d In APIData("data")
If d("title") = ColumnName Then
colID = d("id")
ColIDByName = colID
End If
Next
End Function
Function CollectionToArray(C As Collection) As Variant()
Dim A() As Variant
ReDim A(0 To C.Count - 1)
Dim i As Integer
For i = 1 To C.Count
A(i - 1) = C.Item(i)
Next
CollectionToArray = A
End Function
Public Function SmartSheetDateToExcelDate(SmartSheetDate As String)
ExcelDate = Left(SmartSheetDate, 4) & "/" & Mid(SmartSheetDate, 6, 2) & "/" & Mid(SmartSheetDate, 9, 2)
SmartSheetDateToExcelDate = ExcelDate
End Function
Public Function Prefill(PRID As String, SheetID As String, ByVal Map As Scripting.Dictionary)
Dim SearchResponse As WebResponse
Dim RowResponse As WebResponse
Set SearchResponse = SearchSmartSheet(PRID, SheetID)
Set SearchData = WebHelpers.ParseJson(SearchResponse.Content)
Debug.Print "Json response : "
Debug.Print WebHelpers.ConvertToJson(SearchData)
Set RowObject = SearchData("results")
' Check number of rows returned, throw error if multiple
If RowObject.Count > 1 Then
errMessage = MsgBox("ERROR! : Multiple rows retuned, please check PRID and/or enter manually", vbCritical, "Error!")
Else:
' Assign Row ID
For Each i In RowObject
Debug.Print (i("objectId"))
Row_id = i("objectId")
Next
End If
Debug.Print ("Row ID :" & Row_id)
' Get Row
Set RowResponse = SmartSheetGet("sheets/" & SheetID & "/rows/" & Row_id)
Set RowData = JsonConverter.ParseJson(RowResponse.Content)
Set RowData = RowData("cells")
' Map the data
Debug.Print ("Fields mapped: ")
For Each C In RowData
SScolID = C("columnId")
If Map.Exists(SScolID) = True Then
Range(Map(SScolID)) = C("value")
Debug.Print (Map(SScolID))
End If
Next
Final = MsgBox("Data mapped from SmartSheet!", vbDefaultButton1, "Data Map Success!")
End Function
Public Function ProcessAPI(APIObject As WebResponse, returnFields As String)
Set ParsedResponse = JsonConverter.ParseJson(APIObject.Content)
Debug.Print (ParsedResponse(returnFields))
ProcessAPI = ParsedResponse(returnFields)
End Function
Public Function SearchSmartSheet(query As String, SheetID As String)
' Perform Search Query on SmartSheet Sheet
Debug.Print (SheetID & "-" & query)
Set APIReturn = SmartSheetGet("/search/sheets/" & SheetID & "?query=" & query)
Debug.Print APIReturn.Content
Set SearchSmartSheet = APIReturn
End Function
Public Function GetColumnOptions(ColumnID As String, APIReturn As WebResponse)
Dim ColOptions As New Collection
Set APIData = JsonConverter.ParseJson(APIReturn.Content)
For Each i In APIData("data")
If i("id") = ColumnID Then
For Each o In i("options")
ColOptions.Add o
Debug.Print o
Next
End If
Next
Set GetColumnOptions = ColOptions
End Function
Public Function SearchForPRID(PRID As String, SheetID As String)
Dim APIReturn As WebResponse
Set APIReturn = SearchSmartSheet(PRID, SheetID)
Dim APIData As Object
Set APIData = JsonConverter.ParseJson(APIReturn.Content)
' Check to see if PRID is already added and generate error if it is.
If APIData("totalCount") = 1 Then
Debug.Print ("PRID Exists")
For Each i In APIData("results")
For Each C In i("contextData")
Debug.Print (C)
thing = MsgBox("This PRID has already been added under " & C & ".", vbCritical, "Existing PRID Found")
Next
Debug.Print "objecttype : " & i("objectType")
Debug.Print "objectid : " & i("objectId")
If i("objectType") = "row" Then
rowID = i("objectId")
Debug.Print ("rowid instance 1 : " & rowID)
End If
Next
SearchForPRID = rowID
Debug.Print ("rowid instance 2 : " & rowID)
ElseIf APIData("totalCount") > 1 Then
boxResponse = MsgBox("multiple prids returned", vbCritical, "error")
End
Else
Debug.Print ("SearchForPRID - Success")
SearchForPRID = "False"
End If
End Function
Public Function CycleFields(record, fields)
' Cycle Through fields in LookupFields Array
For Each field In fields
Debug.Print (record(field))
' Write value to current field
ActiveCell.Value = (record(field))
' Move right one column
ActiveCell.Offset(0, 1).Select
Next
' Move down a row
ActiveCell.Offset(1, 0).Select
' Count size of array and move left that many columns
FieldCount = UBound(fields) - LBound(fields) + 1
ActiveCell.Offset(0, FieldCount * -1).Select
End Function