NguyenDang95
Member
Giới thiệu sơ lược về SharePoint:
SharePoint là một hệ thống quản lý tài liệu, trang web nội bộ, làm việc cộng tác được nhiều doanh nghiệp ứng dụng rộng rãi trên thế giới. Theo như Microsoft mô tả, SharePoint cho phép (nguồn: SharePoint là gì - Microsoft):
Qua thực tế công việc, người dùng thường mong muốn những ứng dụng Office như Excel hay Outlook có thể tương tác tự động với SharePoint ở một chừng mực nào đó, và tất nhiên chúng ta sẽ phải phụ thuộc vào VBA được tích hợp vào các ứng dụng Office. Mặc dù VBA đã có tuổi đời gần 30 năm (xuất hiện từ năm 1993) và tỏ ra cũ kỹ cũng như không thân thiện với môi trường internet (đây là lý do tại sao Microsoft đã ngừng phát triển tính năng VBA và thay vào đó tìm đến một ngôn ngữ đa nền tảng như JavaScript, TypeScript, hiện đang có Office JS và Office Scripts), tuy vậy với những công cụ sẵn có hiện tại, người dùng có thể viết một macro VBA tương tác với một dịch vụ trực tuyến nào đó thông qua REST API nhằm mục đích như tiêu đề bài viết này chẳng hạn.
Microsoft xây dựng Graph API làm nền tảng lập trình kết nối đến các dịch vụ trực tuyến (vd: OneDrive, Team, Outlook on the web, v.v), để viết được macro VBA tương tác với nó, trước hết chúng ta cần ngâm cứu tài liệu: Get access on behalf of a user
Sau khi ngâm cứu kỹ tài liệu cũng như tiến hành đăng ký tài khoản Azure, lấy các thông tin cần thiết, chúng ta có thể viết một macro VBA với những chức năng như sau:
Class Module MicrosoftGraphOAuth2:
(Code trong bài viết này chỉ trình bày một phần, mọi người có thể tìm thấy code đầy đủ trong tập tin đính kèm theo bài viết này.)
Thử đăng nhập xem sao (lưu ý: trong video sử dụng tài khoản Microsoft 365 E5 Developer để minh họa):
Bài viết dài quá nên mình xin tạm dừng tại đây. Phần tiếp theo mình sẽ trình bày một số ví dụ thực tế mà người dùng thường yêu cầu.
Xin cảm ơn mọi người đã kiên nhẫn đọc bài viết này.
SharePoint là một hệ thống quản lý tài liệu, trang web nội bộ, làm việc cộng tác được nhiều doanh nghiệp ứng dụng rộng rãi trên thế giới. Theo như Microsoft mô tả, SharePoint cho phép (nguồn: SharePoint là gì - Microsoft):
- Dựng site mạng nội bộ, rồi tạo trang, thư viện tài liệu và danh sách.
- Thêm phần web để tùy chỉnh nội dung của bạn.
- Hiển thị hình ảnh trực quan, tin tức và cập nhật quan trọng với site nhóm hoặc giao tiếp.
- Khám phá, theo dõi và tìm kiếm site, tệp cùng mọi người trong toàn công ty.
- Quản lý công việc hàng ngày của bạn với quy trình, biểu mẫu và danh sách.
- Đồng bộ và lưu trữ tệp trong đám mây để bất cứ ai cũng có thể làm việc bảo mật với bạn.
- Bắt đầu trên tin tức on-the-go với ứng dụng dành cho thiết bị di động.
Qua thực tế công việc, người dùng thường mong muốn những ứng dụng Office như Excel hay Outlook có thể tương tác tự động với SharePoint ở một chừng mực nào đó, và tất nhiên chúng ta sẽ phải phụ thuộc vào VBA được tích hợp vào các ứng dụng Office. Mặc dù VBA đã có tuổi đời gần 30 năm (xuất hiện từ năm 1993) và tỏ ra cũ kỹ cũng như không thân thiện với môi trường internet (đây là lý do tại sao Microsoft đã ngừng phát triển tính năng VBA và thay vào đó tìm đến một ngôn ngữ đa nền tảng như JavaScript, TypeScript, hiện đang có Office JS và Office Scripts), tuy vậy với những công cụ sẵn có hiện tại, người dùng có thể viết một macro VBA tương tác với một dịch vụ trực tuyến nào đó thông qua REST API nhằm mục đích như tiêu đề bài viết này chẳng hạn.
Microsoft xây dựng Graph API làm nền tảng lập trình kết nối đến các dịch vụ trực tuyến (vd: OneDrive, Team, Outlook on the web, v.v), để viết được macro VBA tương tác với nó, trước hết chúng ta cần ngâm cứu tài liệu: Get access on behalf of a user
Sau khi ngâm cứu kỹ tài liệu cũng như tiến hành đăng ký tài khoản Azure, lấy các thông tin cần thiết, chúng ta có thể viết một macro VBA với những chức năng như sau:
- Xin quyền truy cập vào tài nguyên của tài khoản người dùng.
- Lấy access token và đổi lấy access token mới khi access token cũ hết hạn.
- Dùng access token để tương tác với SharePoint trong thẩm quyền mà người dùng đã đồng ý trao cho.
Class Module MicrosoftGraphOAuth2:
Code:
Option Explicit
Private m_ApplicationName As String
Private m_ClientId As String
Private m_ClientSecret As String
Private m_Scope As Variant
Private m_AccessToken As String
Private m_FileResources As FileResources
Public Property Get FileResources() As FileResources
Set FileResources = m_FileResources
End Property
Public Property Set FileResources(Value As FileResources)
Set m_FileResources = Value
End Property
Public Property Get ApplicationName() As String
ApplicationName = m_ApplicationName
End Property
Public Property Let ApplicationName(Value As String)
m_ApplicationName = Value
End Property
Public Property Get ClientId() As String
ClientId = m_ClientId
End Property
Public Property Let ClientId(Value As String)
m_ClientId = Value
End Property
Public Property Get ClientSecret() As String
ClientSecret = m_ClientSecret
End Property
Public Property Let ClientSecret(Value As String)
m_ClientSecret = Value
End Property
Public Property Get Scope() As Variant
Scope = m_Scope
End Property
Public Property Let Scope(Value As Variant)
m_Scope = Value
End Property
Public Property Get AccessToken() As String
AccessToken = m_AccessToken
End Property
Public Property Let AccessToken(Value As String)
m_AccessToken = Value
End Property
Public Sub AuthorizeOAuth2()
Dim objWinHttp As WinHttp.WinHttpRequest
Dim strRequestBody As String
Dim strURL As String
Dim objReg As RegistryUtility
Dim strAuthorizationCode As String
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.TextStream
Dim strFolder As String
Dim strFile As String
Dim strAccessToken As String
Dim objJson As Scripting.Dictionary
Dim dteExpTime As Date
Dim strRefreshToken As String
strFolder = Environ$("APPDATA") & "\" & ApplicationName
strFile = strFolder & "\client_id_" & ClientId & ".token-response"
Set objReg = New RegistryUtility
Set objFSO = New Scripting.FileSystemObject
If ApplicationName = vbNullString Then
Err.Raise vbObjectError + 10, , "Please specify a name for your application"
End If
If objFSO.FolderExists(strFolder) Then
Set objFolder = objFSO.GetFolder(strFolder)
If objFSO.FileExists(strFile) Then
If objReg.RegValueExists("HKEY_CURRENT_USER\Software\MicrosoftOAuth2VBA\" & ApplicationName & "\" & ClientId & "\AccessTokenExpirationTime") Then
dteExpTime = CDate(objReg.ReadRegValue("HKEY_CURRENT_USER\Software\MicrosoftOAuth2VBA\" & ApplicationName & "\" & ClientId & "\AccessTokenExpirationTime"))
If DateDiff("s", Now, dteExpTime) <= 0 Then
Set objFile = objFSO.OpenTextFile(strFile, ForReading, False)
Set objJson = JsonConverter.ParseJson(objFile.ReadAll)
objFile.Close
strRefreshToken = objJson.Item("refresh_token")
AccessToken = RefreshAccessToken(strRefreshToken)
Else
Set objFile = objFSO.OpenTextFile(strFile, ForReading, False)
Set objJson = JsonConverter.ParseJson(objFile.ReadAll)
objFile.Close
AccessToken = objJson.Item("access_token")
End If
Else: AccessToken = GetAccessToken
End If
Else: AccessToken = GetAccessToken
End If
Else
Set objFolder = objFSO.CreateFolder(strFolder)
AccessToken = GetAccessToken
End If
Dim objFileResources As FileResources
Set objFileResources = New FileResources
objFileResources.AccessToken = AccessToken
Set FileResources = objFileResources
End Sub
Private Function GetAccessToken() As String
Dim objBrowser As UserForm1
Dim objWinHttp As WinHttp.WinHttpRequest
Dim strURL As String
Dim strRequestBody As String
Dim strAuthorizationCode As String
Dim strFile As String
Dim strFolder As String
Dim strAccessToken As String
Dim objReg As RegistryUtility
Dim objJson As Scripting.Dictionary
Dim objFSO As Scripting.FileSystemObject
Dim objFile As Scripting.TextStream
Set objFSO = New Scripting.FileSystemObject
Set objReg = New RegistryUtility
Set objBrowser = New UserForm1
strFolder = Environ$("APPDATA") & "\" & ApplicationName
strFile = strFolder & "\client_id_" & ClientId & ".token-response"
Dim objWebUtilities As WebUtilities
Set objWebUtilities = New WebUtilities
If Not IsEmpty(Scope) Then
strURL = "https://login.microsoftonline.com/common/oauth2/v2.0/authorize?" & "client_id=" & ClientId & "&scope=" & objWebUtilities.URLEncode(Join(Scope, " ")) & "&response_type=code&redirect_uri=" & objWebUtilities.URLEncode("https://login.microsoftonline.com/common/oauth2/nativeclient")
Else
Err.Raise vbObjectError + 13, , "Scope cannot be null. Please specify a valid scope and try again!"
End If
objBrowser.ClientId = ClientId
objBrowser.ApplicationName = ApplicationName
objBrowser.WebBrowser1.Navigate strURL
objBrowser.Show vbModal
If objReg.RegValueExists("HKEY_CURRENT_USER\Software\MicrosoftOAuth2VBA\" & ApplicationName & "\" & ClientId & "\AuthorizationCode") Then
strAuthorizationCode = objReg.ReadRegValue("HKEY_CURRENT_USER\Software\MicrosoftOAuth2VBA\" & ApplicationName & "\" & ClientId & "\AuthorizationCode")
objReg.DeleteRegValue "HKEY_CURRENT_USER\Software\MicrosoftOAuth2VBA\" & ApplicationName & "\" & ClientId & "\AuthorizationCode"
End If
If strAuthorizationCode <> vbNullString Then
strRequestBody = "code=" & strAuthorizationCode & "&" & _
"client_id=" & ClientId & "&" & _
"redirect_uri=" & objWebUtilities.URLEncode("https://login.microsoftonline.com/common/oauth2/nativeclient") & "&" & _
"grant_type=authorization_code"
Set objWinHttp = New WinHttp.WinHttpRequest
With objWinHttp
.Open "POST", "https://login.microsoftonline.com/common/oauth2/v2.0/token", False
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.SetRequestHeader "Accept", "application/json'"
.Send strRequestBody
If .Status = 200 Then
Set objJson = JsonConverter.ParseJson(.ResponseText)
strAccessToken = objJson.Item("access_token")
If strAccessToken <> vbNullString Then
GetAccessToken = strAccessToken
Set objFile = objFSO.CreateTextFile(strFile, True)
objFile.Write .ResponseText
objFile.Close
objReg.WriteRegValue "HKEY_CURRENT_USER\Software\MicrosoftOAuth2VBA\" & ApplicationName & "\" & ClientId & "\AccessTokenExpirationTime", CStr(DateAdd("s", CDbl(objJson.Item("expires_in")), Now)), REG_SZ
Else: Err.Raise vbObjectError + 2, , "Failed to get access code"
End If
Else
Dim objJson As Scripting.Dictionary
Set objJson = JsonConverter.ParseJson(.ResponseText)
Err.Raise vbObjectError + .Status, , objJson.Item("error_description")
End If
End With
Else
Err.Raise vbObjectError + 1, , "Failed to obtain the authorization code."
End If
End Function
Private Function RefreshAccessToken(RefreshToken As String) As String
Dim objWinHttp As WinHttp.WinHttpRequest
Dim objJson As Scripting.Dictionary
Dim strRequestBody As String
Dim strFolder As String
Dim strFile As String
Dim objReg As RegistryUtility
strRequestBody = "client_id=" & ClientId & "&" & _
"refresh_token=" & RefreshToken & "&" & _
"grant_type=refresh_token"
Set objWinHttp = New WinHttp.WinHttpRequest
With objWinHttp
.Open "POST", "https://login.microsoftonline.com/common/oauth2/v2.0/token"
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.SetRequestHeader "Accept", "application/json'"
.Send strRequestBody
If .Status = 200 Then
Set objJson = JsonConverter.ParseJson(.ResponseText)
strFolder = Environ$("APPDATA") & "\" & ApplicationName
strFile = strFolder & "\client_id_" & ClientId & ".token-response"
Call SaveNewAccessToken(strFile, objJson.Item("access_token"))
RefreshAccessToken = objJson.Item("access_token")
Set objReg = New RegistryUtility
objReg.WriteRegValue "HKEY_CURRENT_USER\Software\MicrosoftOAuth2VBA\" & ApplicationName & "\" & ClientId & "\AccessTokenExpirationTime", CStr(DateAdd("s", CDbl(objJson.Item("expires_in")), Now)), REG_SZ
End If
End With
End Function
Private Sub SaveNewAccessToken(AccessTokenFile As String, NewAccessToken As String)
Dim objFSO As Scripting.FileSystemObject
Dim objFile As Scripting.TextStream
Dim strText As String, strOldText As String, strNewText As String
Set objFSO = New Scripting.FileSystemObject
If objFSO.FileExists(AccessTokenFile) Then
strNewText = Chr(34) & "access_token" & Chr(34) & ":" & Chr(34) & NewAccessToken & Chr(34)
Set objFile = objFSO.OpenTextFile(AccessTokenFile)
strText = objFile.ReadAll
objFile.Close
strOldText = Chr(34) & "access_token" & Chr(34) & ":" & Chr(34) & JsonConverter.ParseJson(strText).Item("access_token") & Chr(34)
strText = VBA.Replace(strText, strOldText, strNewText, , , vbTextCompare)
Set objFile = objFSO.OpenTextFile(AccessTokenFile, ForWriting)
objFile.Write strText
objFile.Close
Else
Call GetAccessToken
End If
End Sub
Public Sub LogOut()
Dim objWinHttp As WinHttp.WinHttpRequest
Dim objFSO As Scripting.FileSystemObject
Dim strFolder As String
Dim objReg As RegistryUtility
Dim objBrowser As UserForm1
Dim objWebUtilities As WebUtilities
Set objWebUtilities = New WebUtilities
Set objBrowser = New UserForm1
objBrowser.WebBrowser1.Navigate "https://login.microsoftonline.com/common/oauth2/v2.0/logout?post_logout_redirect_uri=" & objWebUtilities.URLEncode("https://login.microsoftonline.com/common/oauth2/nativeclient")
objBrowser.Show vbModal
Set objFSO = New Scripting.FileSystemObject
strFolder = Environ$("APPDATA") & "\" & ApplicationName
If objFSO.FileExists(strFolder & "\client_id_" & ClientId & ".token-response") Then objFSO.GetFile(strFolder & "\client_id_" & ClientId & ".token-response").Delete
Set objReg = New RegistryUtility
If objReg.RegKeyExists(HKEY_CURRENT_USER, "Software\MicrosoftOAuth2VBA\" & ApplicationName & "\" & ClientId) Then
objReg.DeleteRegKey HKEY_CURRENT_USER, "Software\MicrosoftOAuth2VBA\" & ApplicationName & "\" & ClientId
End If
End Sub
(Code trong bài viết này chỉ trình bày một phần, mọi người có thể tìm thấy code đầy đủ trong tập tin đính kèm theo bài viết này.)
Thử đăng nhập xem sao (lưu ý: trong video sử dụng tài khoản Microsoft 365 E5 Developer để minh họa):
Bài viết dài quá nên mình xin tạm dừng tại đây. Phần tiếp theo mình sẽ trình bày một số ví dụ thực tế mà người dùng thường yêu cầu.
Xin cảm ơn mọi người đã kiên nhẫn đọc bài viết này.