' ============================================================
' modSheetsTest.bas
' Test cac action Sheets: read, write, append, clear,
' getInfo, create, rename, delete, batchUpdate
'
' Cach dung:
' 1. Mo Excel 64-bit, Alt+F11
' 2. Insert > Module, paste file nay vao
' 3. Sua SHEET_ID thanh Spreadsheet ID thuc te
' 4. Goi tung ham Test_* trong Immediate Window (Ctrl+G)
' ============================================================
' ------------------------------------------------------------
' DECLARE
' ------------------------------------------------------------
#If VBA7 Then
Private Declare PtrSafe Function GBridgeExecute Lib "GoogleSvc.dll" _
( _
ByVal reqJsonPtr As LongPtr, _
ByVal outBuf As LongPtr, _
ByVal outBufSize As Long) As LongLong
#End If
' ------------------------------------------------------------
' CONST - sua SHEET_ID truoc khi test
' ------------------------------------------------------------
'Private Const SHEET_ID As String = "PUT_YOUR_SPREADSHEET_ID_HERE"
Private Const SHEET_ID As String = "1punDQ-pRaMsopULsUaNthuHri5pj4ZrhNLFkOD3qkoo" ' <- SUA O DAY
Private Const BUF_SIZE As Long = 65536 ' 64 KB
' ------------------------------------------------------------
' WRAPPER (chep tu modAuthTest, giu nhat quan)
' ------------------------------------------------------------
Private Function ExecuteJSON(ByVal sJSON As String) As String
Dim buf() As Integer
Dim bufSize As Long
Dim bufSize2 As Long
Dim ret As LongLong
Dim needed As Long
bufSize = BUF_SIZE
ReDim buf(0 To bufSize - 1)
ret = GBridgeExecute(StrPtr(sJSON), VarPtr(buf(0)), bufSize)
If ret < 0 Then
needed = CLng(-ret) + 1
bufSize2 = needed
ReDim buf(0 To bufSize2 - 1)
ret = GBridgeExecute(StrPtr(sJSON), VarPtr(buf(0)), bufSize2)
End If
If ret >= 0 Then
ExecuteJSON = Left$(buf2Str(buf), CLng(ret))
Else
ExecuteJSON = "{""ok"":false,""error"":""buffer van qua nho""}"
End If
End Function
Private Function buf2Str(buf() As Integer) As String
Dim i As Long
Dim s As String
For i = 0 To UBound(buf)
If buf(i) = 0 Then Exit For
s = s & ChrW(buf(i))
Next i
buf2Str = s
End Function
Private Sub PrintResult(ByVal sLabel As String, ByVal sJSON As String)
Debug.Print "------------------------------------------------------------"
Debug.Print "[" & sLabel & "]"
Debug.Print sJSON
End Sub
' ------------------------------------------------------------
' HELPER - tao JSON request don gian
' ------------------------------------------------------------
Private Function MakeReq(ByVal sAction As String, ByVal sExtra As String) As String
If sExtra = "" Then
MakeReq = "{""action"":""" & sAction & """,""spreadsheetId"":""" & SHEET_ID & """}"
Else
MakeReq = "{""action"":""" & sAction & """,""spreadsheetId"":""" & SHEET_ID & """," & sExtra & "}"
End If
End Function
' ------------------------------------------------------------
' TEST
' ------------------------------------------------------------
' Test_SheetsRead: doc du lieu 1 vung
' Ket qua mong doi: {"ok":true,"data":{"values":[...],"range":"..."}}
Public Sub Test_SheetsRead()
Dim sReq As String
sReq = MakeReq("sheets.read", """range"":""Sheet1!A1:C5""")
PrintResult "sheets.read", ExecuteJSON(sReq)
End Sub
' Test_SheetsWrite: ghi du lieu vao 1 vung
' Ket qua mong doi: {"ok":true,"data":{"updatedRange":"...","updatedRows":2,...}}
Public Sub Test_SheetsWrite()
Dim sReq As String
sReq = MakeReq("sheets.write", """range"":""Sheet1!A1"",""values"":[[""Ten"",""Tuoi""],[""An"",25]]")
PrintResult "sheets.write", ExecuteJSON(sReq)
End Sub
' Test_SheetsAppend: them dong moi vao cuoi du lieu
' Ket qua mong doi: {"ok":true,"data":{"updatedRows":1,...}}
Public Sub Test_SheetsAppend()
Dim sReq As String
sReq = MakeReq("sheets.append", """range"":""Sheet1!A1"",""values"":[[""Binh"",30]]")
PrintResult "sheets.append", ExecuteJSON(sReq)
End Sub
' Test_SheetsClear: xoa du lieu trong 1 vung (giu dinh dang)
' Ket qua mong doi: {"ok":true,"data":{"clearedRange":"..."}}
Public Sub Test_SheetsClear()
Dim sReq As String
sReq = MakeReq("sheets.clear", """range"":""Sheet1!A1:C10""")
PrintResult "sheets.clear", ExecuteJSON(sReq)
End Sub
' Test_SheetsGetInfo: lay thong tin spreadsheet va danh sach tab
' Ket qua mong doi: {"ok":true,"data":{"title":"...","sheets":[{"sheetId":0,"title":"Sheet1",...}]}}
Public Sub Test_SheetsGetInfo()
PrintResult "sheets.getInfo", ExecuteJSON(MakeReq("sheets.getInfo", ""))
End Sub
' Test_SheetsCreate: tao spreadsheet moi
' Ket qua mong doi: {"ok":true,"data":{"spreadsheetId":"...","title":"...","webViewLink":"..."}}
' SAU KHI CHAY: copy spreadsheetId de dung trong Test_SheetsRename/Delete
Public Sub Test_SheetsCreate()
Dim sReq As String
sReq = "{""action"":""sheets.create"",""title"":""Test GoogleSvc""}"
PrintResult "sheets.create", ExecuteJSON(sReq)
End Sub
' Test_SheetsRename: doi ten 1 tab (can sheetId lay tu getInfo)
' sheetId = 0 la tab dau tien (Sheet1 mac dinh)
' Ket qua mong doi: {"ok":true,"data":{"status":"doi ten thanh cong",...}}
Public Sub Test_SheetsRename()
Dim sReq As String
' sheetId: lay tu ket qua Test_SheetsGetInfo
' Sua sheetId va newTitle truoc khi chay
sReq = MakeReq("sheets.rename", """sheetId"":0,""newTitle"":""DuLieu""")
PrintResult "sheets.rename", ExecuteJSON(sReq)
End Sub
' Test_SheetsDelete: xoa 1 tab (can sheetId, spreadsheet phai con >= 1 tab)
' CANH BAO: thao tac nay khong hoan tac duoc.
' Ket qua mong doi: {"ok":true,"data":{"status":"xoa sheet thanh cong",...}}
Public Sub Test_SheetsDelete()
Dim sSheetID As String
Dim sReq As String
' Dung spreadsheetId cua sheet vua tao (Test_SheetsCreate)
' Sua gia tri duoi day truoc khi chay
Dim sTmpSpreadsheetID As String
sTmpSpreadsheetID = "PUT_NEW_SPREADSHEET_ID_HERE"
' sheetId = 0 la tab mac dinh dau tien
sReq = "{""action"":""sheets.delete"",""spreadsheetId"":""" & sTmpSpreadsheetID & """,""sheetId"":0}"
' CANH BAO: goi nay se xoa tab - chi chay khi spreadsheet co >= 2 tab
' PrintResult "sheets.delete", ExecuteJSON(sReq)
Debug.Print "[sheets.delete] Bo qua - bo comment dong PrintResult de chay that su"
End Sub
' Test_SheetsBatchUpdate: dinh dang in dam header row
' Dung batchUpdate de to mau nen header (repeatCell)
' Ket qua mong doi: {"ok":true,"data":{"replyCount":1}}
Public Sub Test_SheetsBatchUpdate()
Dim sReq As String
' Request: to mau nen xanh la + chu trang cho hang dau tien (A1:Z1)
' sheetId = 0 (tab dau tien), startRowIndex=0, endRowIndex=1 = hang 1
sReq = MakeReq("sheets.batchUpdate", _
"""requests"":[{""repeatCell"":{" & _
"""range"":{""sheetId"":0,""startRowIndex"":0,""endRowIndex"":1}," & _
"""cell"":{""userEnteredFormat"":{" & _
"""backgroundColor"":{""red"":0.2,""green"":0.5,""blue"":0.9}," & _
"""textFormat"":{""bold"":true,""foregroundColor"":{""red"":1,""green"":1,""blue"":1}}" & _
"}}," & _
"""fields"":""userEnteredFormat(backgroundColor,textFormat)""" & _
"}}]")
PrintResult "sheets.batchUpdate (header format)", ExecuteJSON(sReq)
End Sub
' Test_AllSheets: chay toan bo luong Sheets theo thu tu dung
' (khong bao gom Delete vi co rui ro mat du lieu)
Public Sub Test_AllSheets()
Debug.Print "============================================================"
Debug.Print " TEST TOAN BO SHEETS ACTIONS"
Debug.Print "============================================================"
Test_SheetsGetInfo
Test_SheetsWrite
Test_SheetsRead
Test_SheetsAppend
Test_SheetsBatchUpdate
Test_SheetsClear
Test_SheetsCreate
Debug.Print "============================================================"
Debug.Print " HOAN THANH - Kiem tra Immediate Window"
Debug.Print "============================================================"
End Sub
github.com
Ý nghĩa thực tế
