VBA tải file có yêu cầu đăng nhập

[viethung78]

Thân gửi các anh chị trong diễn đàn,

Cũng liên quan đến chủ đề URLToDownloadFile như trong chủ đề này trên diễn đàn: https://www.giaiphapexcel.com/diend...file-về-khi-đường-dẫn-có-chuỗi-unicode.67281/

Mình phải tải file được chia sẻ trong mạng SharePoint của công ty và phải đăng nhập trình duyệt mới tải được. Với cách thức download như chủ đề trên chỉ có thể download dạng file được chia sẻ cho bất kỳ ai có liên kết không phải đăng nhập.

Nên xin thỉnh giáo các anh chị phương cách nào có thể tải được file yêu cầu đăng nhập trước, hoặc code nào có sử dụng trình duyệt đã đăng nhập để tải về được.

Xin cảm ơn!

 

[befaint]

Lấy link API của sharepoint và user + password là tải về được.

 

[viethung78]

Lấy link API của sharepoint và user + password là tải về được.

Cảm ơn bạn đã định hướng. Bạn có thể hướng dẫn chi tiết hơn được không?

 

[befaint]

Cảm ơn bạn đã định hướng. Bạn có thể hướng dẫn chi tiết hơn được không?

Lấy link API, kết nối tới SharePoint theo user + password, giữ phiên làm việc.

Kết nối tới link file trong SharePoint cần lấy rồi tải về thôi.

Ngoài ra, tạo folder, upload file lên SharePoint được luôn.

 

[nguyendang95]

Cảm ơn bạn đã định hướng. Bạn có thể hướng dẫn chi tiết hơn được không?

Hiện tại là sử dụng Microsoft Graph API.
Viết macro xác thực OAuth2 theo hướng dẫn tại đây, có thể sử dụng thư viện WinHTTPRequest hoặc XMLHTTPRequest:
Get access on behalf of a user
Sau khi đã có được Access Token thì viết macro theo hướng dẫn:
Download the contents of a DriveItem

Ví dụ (lưu ý macro dưới đây chỉ là minh họa):

Public Sub DownloadFile(SiteId As String, FolderPath As String, FileName As String, DestinationFolder As String)
    Dim objWinHttp As WinHttp.WinHttpRequest
    Dim objRandom As Random
    Dim decCurrentPos As Variant, decChunkSize As Variant, decTotalSize As Variant
    Dim objJson As Scripting.Dictionary
    Set objWinHttp = New WinHttp.WinHttpRequest
    With objWinHttp
        .Open "GET", "https://graph.microsoft.com/v1.0/sites/" & SiteId & "/drive/items/root:/" & FolderPath & "/" & FileName & "?$select=size", True
        .SetRequestHeader "Authorization", "Bearer " & ActiveService.AccessToken
        .Send
        .WaitForResponse
        If .Status = 200 Then
            Set objJson = JsonConverter.ParseJson(.ResponseText)
            decTotalSize = CDec(objJson.Item("size"))
        Else: Call HandleError(.ResponseText)
        End If
    End With
    Set objWinHttp = Nothing
    Set objWinHttp = New WinHttp.WinHttpRequest
    decChunkSize = CDec(decChunkSize)
    decChunkSize = 10485760
    decCurrentPos = CDec(decCurrentPos)
    decCurrentPos = 0
    While decTotalSize - decCurrentPos > 0
        Set objWinHttp = New WinHttp.WinHttpRequest
        With objWinHttp
            .Open "GET", "https://graph.microsoft.com/v1.0/sites/" & SiteId & "/drive/items/root:/" & FolderPath & "/" & FileName & ":/content", True
            If decTotalSize - decCurrentPos > 0 Then
                .SetRequestHeader "Range", "bytes=" & CStr(decCurrentPos) & "-" & CStr(decCurrentPos + decChunkSize - 1)
            Else: .SetRequestHeader "Range", "bytes=" & CStr(decCurrentPos) & "-" & CStr(decTotalSize - 1)
            End If
            .SetRequestHeader "Authorization", "Bearer " & ActiveService.AccessToken
            .SetRequestHeader "Content-Type", "application/octet-stream"
            .Send
            .WaitForResponse
            If .Status = 206 Then
                Set objRandom = New Random
                objRandom.OpenFile DestinationFolder & "\" & FileName, ForAppending
                objRandom.WriteBytes .ResponseBody
                objRandom.CloseFile
                Set objRandom = Nothing
                decCurrentPos = decCurrentPos + decChunkSize
            Else: Call HandleError(.ResponseText)
            End If
        End With
        Set objWinHttp = Nothing
    Wend
End Sub

Private Function BytesToMegabytes(Bytes As Double) As Double
    BytesToMegabytes = Bytes / 1024 / 1024
End Function

Private Sub HandleError(Source As String)
    Dim objJson As Scripting.Dictionary
    Set objJson = JsonConverter.ParseJson(Source)
    Err.Raise vbObjectError, objJson.Item("error")("code"), objJson.Item("error")("message")
End Sub