Một ý tưởng viết macro VBA tương tác với Google Drive từ Excel

Chia sẻ bởi:hands

★★★★★

‹ LỌC VÀ ĐẾM DỮ LIỆU TRÙNG NHAU Nhờ viết code cho file lập kế... ›

Quảng cáo

Xin chào mọi người.
Sau một thời gian nhận thấy có nhiều người dùng đặt vấn đề về khả năng macro VBA trong Excel tương tác với Google Drive nói chung và các dịch vụ của Google nói riêng và sau khi nghiên cứu cách viết macro VBA cũng như ngâm cứu tài liệu của Google.
Mình xin chia sẻ một ý tưởng thông qua một tệp ví dụ đính kèm theo bài viết này với những chức năng như sau:

Quản lý tập tin, thư mục trong một thư mục nhất định trên Google Drive với những chức năng cơ bản như tải lên, tải xuống tập tin, đổi tên, xóa vĩnh viễn tập tin/thư mục.
Tạo email, tải tệp đính kèm lên thư mục trong Google Drive và lấy shareable link đưa vào email mới tạo.
Tiến trình tải lên/tải xuống tập tin được ghi nhận ở thanh Status Bar của Excel (góc trái dưới cùng)

Macro VBA trong tệp Excel trên có sử dụng:

Thư viện VBA-JSON của tác giả timhall: [URL='github.com/VBA-tools/VBA-JSON']VBA-JSON
Hai hàm URLEncode và URLDecode (ExcelVBA.ru): [URL='gist.github.com/jvarn/5e11b1fd741b5f79d8a516c9c2368f17']URL Encode and Decode VBA functions for Excel on Mac or Windows including UTF-8 support. Source: ExcelVBA.ru

Mời mọi người xem tệp bên dưới.

ý tưởng hay đó … nhưng cảm giác thấy hơi cà chua

Thử nghiên cứu thêm Web Server xem nó cũng hay đấy …. Hoặc cái ISS phía sau cái ISS là 1 Web Server đấy có điều muốn sử dụng nó phải cấu hình = tay … còn cấu hình = code cũng rất cà chua

còn nghe tây trên google nó tù đồn ( 9 xác hay ko 9 xác thì = No biết ) là phía sau cái Ms Server cũng là 1 cái Web Server chạy ngầm

Nói ra thì xấu hổ, nhưng thật ra mình không biết gì về lập trình web, với lại mình đã nghĩ nát cả óc rồi mà không còn cách nào khác mà nên chỉ đành dùng một Userform như một trình duyệt web (Internet Explorer) để xin quyền truy cập vào Drive của người dùng (Microsoft Edge không cung cấp COM DLL để chạy được trên VBA mà phải động đến SeleniumBasic thì rất phiền phức). Rất may là trình duyệt Internet Explorer tuy đã rất cũ nhưng vẫn còn hiển thị tốt trang web của Google lẫn Microsoft, tuy nhiên một số trang (như Notion API chẳng hạn) thì Internet Explorer lại không hiển thị được. Ước gì Microsoft chịu cập nhật cho cái WebView2 như bên .NET thì tốt quá.
Nếu sau năm 2029 Microsoft loại bỏ hoàn toàn Internet Explorer khỏi Windows thì ý tưởng trên sẽ phải xếp xó mất.

Trong tệp Excel trên có chứa một Class Module tên là GoogleOAuth2, đây là thành phần chính chịu trách nhiệm xử lý các vấn đề liên quan đến xác thực OAuth2 như:

Lấy Authorization Code khi người dùng cho phép
Lấy Access Token sau khi đã có Authorization Code
Lưu trữ Access Token cùng với Refresh Token vào một nơi thích hợp để tiện sử dụng mà không cần xin quyền truy cập từ người dùng về sau
Kiểm tra thời hạn của Access Token, nếu hết hạn thì dùng Refresh Token để lấy Access Token mới (theo Google, Access Token chỉ có tác dụng trong vòng một tiếng
Thu hồi Access Token cùng với Refresh Token khi cần thiết

Để trình bày một ví dụ khác về chủ đề bài viết nói trên, chúng ta thử viết một macro chèn, xóa và lấy dữ liệu từ một vùng (Range) bất kỳ trong một Spreadsheet (Google Sheets) trên Drive.
Đầu tiên, tạo một số Class Module như ClearValuesRequest, GetValuesRequest, UpdateValuesRequest và ValueRange (chi tiết vui lòng xem tệp đính kèm theo bài viết này)
Tiếp theo, viết một số thủ tục để thực hiện chức năng chèn, xóa và lấy dữ liệu từ một Range trong Spreadsheet:

Option Explicit

Public Function GetRangeValues(SpreadsheetId As String, A1Range As String) As Variant
    Dim objGoogleOAuth2 As GoogleOAuth2
    Dim objWinHttpRequest As WinHttp.WinHttpRequest
    Dim objDict As Scripting.Dictionary
    Dim objGetValuesRequest As GetValuesRequest
    Set objGetValuesRequest = New GetValuesRequest
    With objGetValuesRequest
        .SpreadsheetId = SpreadsheetId
        .Range = A1Range
    End With
    Set objGoogleOAuth2 = GetCurrentSession
    Set objWinHttpRequest = New WinHttp.WinHttpRequest
    With objWinHttpRequest
        .Open "GET", "sheets.googleapis.com/v4/spreadsheets/" & objGetValuesRequest.ConstructQueryParameters, True
        .SetRequestHeader "Content-Type", "application/json"
        .SetRequestHeader "Accept", "application/json"
        .SetRequestHeader "Authorization", "Bearer " & objGoogleOAuth2.AccessToken
        .Send
        .WaitForResponse
        If .Status = 200 Then
            Set objDict = JsonConverter.ParseJson(.ResponseText)
            If Not IsEmpty(objDict.Item("values")) Then
                GetRangeValues = ConvertJsonToArray(objDict)
            End If
        Else
            MsgBox objDict.Item("message"), vbInformation, "Error"
        End If
    End With
End Function

Public Sub SetRangeValues(SpreadsheetId As String, R1Range As String, Values As Variant)
    Dim objGoogleOAuth2 As GoogleOAuth2
    Dim objWinHttpRequest As WinHttp.WinHttpRequest
    Dim objDict As Scripting.Dictionary
    Dim objUpdateValuesRequest As UpdateValuesRequest
    Dim objValueRange As ValueRange
    Set objValueRange = New ValueRange
    With objValueRange
        .Range = R1Range
        .Values = Values
    End With
    Set objUpdateValuesRequest = New UpdateValuesRequest
    With objUpdateValuesRequest
        .SpreadsheetId = SpreadsheetId
        .Range = R1Range
        .ValueInputOption = USER_ENTERED
        .IncludeValuesInResponse = "false"
    End With
    Set objGoogleOAuth2 = GetCurrentSession
    Set objWinHttpRequest = New WinHttp.WinHttpRequest
    With objWinHttpRequest
        .Open "PUT", "sheets.googleapis.com/v4/spreadsheets/" & objUpdateValuesRequest.ConstructQueryParameters, True
        .SetRequestHeader "Content-Type", "application/json"
        .SetRequestHeader "Accept", "application/json"
        .SetRequestHeader "Authorization", "Bearer " & objGoogleOAuth2.AccessToken
        .Send JsonConverter.ConvertToJson(objValueRange.ToJson)
        .WaitForResponse
        If .Status <> 200 Then
            MsgBox "An error occurred", vbExclamation, "Error"
        End If
    End With
End Sub

Public Sub ClearRangeValues(SpreadsheetId As String, A1OrR1Range As String)
    Dim objGoogleOAuth2 As GoogleOAuth2
    Dim objWinHttpRequest As WinHttp.WinHttpRequest
    Dim objDict As Scripting.Dictionary
    Dim objClearValuesRequest As ClearValuesRequest
    Set objClearValuesRequest = New ClearValuesRequest
    With objClearValuesRequest
        .SpreadsheetId = SpreadsheetId
        .Range = A1OrR1Range
    End With
    Set objGoogleOAuth2 = GetCurrentSession
    Set objWinHttpRequest = New WinHttp.WinHttpRequest
    With objWinHttpRequest
        .Open "POST", "sheets.googleapis.com/v4/spreadsheets/" & objClearValuesRequest.ConstructQueryParameters, True
        .SetRequestHeader "Content-Type", "application/json"
        .SetRequestHeader "Accept", "application/json"
        .SetRequestHeader "Authorization", "Bearer " & objGoogleOAuth2.AccessToken
        .Send
        .WaitForResponse
        If .Status <> 200 Then
            MsgBox "An error occurred", vbExclamation, "Error"
        End If
    End With
End Sub

Public Function GetCurrentSession() As GoogleOAuth2
    Dim objGoogleOAuth2 As GoogleOAuth2
    Set objGoogleOAuth2 = New GoogleOAuth2
    With objGoogleOAuth2
        .ApplicationName = "UploadFileToGoogleDrive"
        .ClientID = "364263102841-sqrgk7k3dv0tnt1eu2mdg1a5o4283110.apps.googleusercontent.com"
        .ClientSecret = "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"
        .Scope = Array("www.googleapis.com/auth/drive")
        .AuthorizeOAuth2
    End With
    Set GetCurrentSession = objGoogleOAuth2
End Function

Private Function Quote(Text As String) As String
    Quote = Chr(34) & Text & Chr(34)
End Function

Private Function ConvertJsonToArray(Json As Scripting.Dictionary) As Variant
    Dim arrValues() As Variant
    Dim i As Long, j As Long
    If Json.Item("values").Count > 1 And Json.Item("values")(1).Count > 1 Then
        ReDim arrValues(1 To Json.Item("values").Count, 1 To Json.Item("values")(1).Count)
        For i = 1 To Json.Item("values").Count
            For j = 1 To Json.Item("values")(i).Count
                arrValues(i, j) = Json.Item("values")(i)(j)
                Debug.Print arrValues(i, j)
            Next
        Next
    ElseIf Json.Item("values").Count = 1 And Json.Item("values")(1).Count > 1 Then
        ReDim arrValues(1 To 1, 1 To Json.Item("values")(1).Count)
        For i = 1 To Json.Item("values")(1).Count
            arrValues(1, i) = Json.Item("values")(1)(i)
        Next
    ElseIf Json.Item("values").Count = 1 And Json.Item("values")(1).Count = 1 Then
        ReDim arrValues(1 To 1)
        arrValues(1) = Json.Item("values")(1)(1)
    End If
    ConvertJsonToArray = arrValues
End Function

Chạy thử macro (trong ví dụ này chỉ trình bày chức năng chèn dữ liệu vào Range trên Google Sheets):

Private Sub SetValues()
    Dim objGoogleOAuth2 As GoogleOAuth2
    Set objGoogleOAuth2 = GetCurrentSession
    SetRangeValues "1t4J0vU57rAv8fPpGWc1J53mZC4A-m0UMfKNcEyVAvmE", "Sheet1!" & Range("A1:J20").Address(True, True, xlR1C1), Range("A1:J20").Value
End Sub

Thủ tục SetRangeValues có ba tham số, tham số thứ nhất là mã Id của Spreadsheet, tệp Spreadsheet này có thể nằm trên Drive của người dùng hoặc được chia sẻ với người dùng với quyền chỉnh sửa, tham số thứ hai là địa chỉ dạng A1 của Range trong tệp Spreadsheet cần chèn (vd: Sheet1!A1:A2), tham số cuối cùng là một giá trị đơn lẻ hoặc một mảng hai chiều để chèn vào Range trong tệp Spreadsheet.

1074

So sánh kết quả:

1073

Tệp Spreadsheet dùng làm mẫu cho bài viết này:
docs.google.com/spreadsheets/d/1t4J0vU57rAv8fPpGWc1J53mZC4A-m0UMfKNcEyVAvmE/edit?usp=share_link