Загрузка файла в Azure Blob Storage с помощью Microsoft.XMLHTTP с прогрессом VBA

Содержание

Вопрос или проблема
Ответ или решение
Обновленный код для загрузки файла с отслеживанием прогресса
Основные изменения и дополнения:

Вопрос или проблема

Я пытаюсь загрузить файл в хранилище, используя Microsoft.XMLHTTP в VBA для MS Access с отслеживанием прогресса. Загрузка без отслеживания прогресса работает нормально, но мне нужно отслеживание прогресса, особенно для больших файлов.

У меня проблема с этой строкой:

 xmlHttp.send fileData

ошибка: Параметр неверен… Я пытался разделить файл на 5 частей и загрузить их, но я делаю что-то не так. Вот фрагмент кода:

 Public Sub UploadToAzureBlob(filePath As String, fileName As String)
    Dim adoStream As Object
    Dim xmlHttp As Object
    Dim responseStatus As Long
    Dim sUrl As String
    Dim fileSize As Long
    Dim bytesSent As Long
    Dim chunkSize As Long
    Dim fileData() As Byte
    Dim progressForm As Form
    Dim numParts As Long

    'On Error GoTo ErrHandler

    filePath = filePath & fileName
    fileName = "/" & URLEncodeJScript(fileName) ' Для Azure в этом формате
    sUrl = blobUrl & fileName & sasToken

    Set adoStream = CreateObject("ADODB.Stream")
    adoStream.Mode = 3
    adoStream.Type = 1
    adoStream.Open
    adoStream.LoadFromFile filePath
 
    fileSize = adoStream.Size
  
    numParts = 5
    chunkSize = fileSize \ numParts
    If chunkSize = 0 Then chunkSize = fileSize

    DoCmd.OpenForm "dlgPRGBAR"
    Set progressForm = Forms!dlgPRGBAR
    
    Set xmlHttp = CreateObject("Microsoft.XMLHTTP")

    bytesSent = 0
    Do While bytesSent < fileSize
        If bytesSent + chunkSize > fileSize Then
            chunkSize = fileSize - bytesSent
        End If
        
        adoStream.Position = bytesSent
        ReDim fileData(0 To chunkSize - 1)
        fileData = adoStream.Read(chunkSize)
        
        Debug.Print "Размер части: " & chunkSize & " Отправлено байт: " & bytesSent

        xmlHttp.Open "PUT", sUrl, False
        xmlHttp.setRequestHeader "x-ms-blob-type", "BlockBlob"
        xmlHttp.setRequestHeader "Content-Length", CStr(chunkSize)
  
        Debug.Print "URL: " & sUrl
        Debug.Print "Content-Length: " & CStr(chunkSize)
        
        xmlHttp.send fileData

        If xmlHttp.status <> 201 And xmlHttp.status <> 202 Then
            Debug.Print "Ошибка: " & xmlHttp.status & " - " & xmlHttp.StatusText
            MsgBox "Ошибка: " & xmlHttp.status & " - " & xmlHttp.StatusText, vbCritical
            GoTo CleanUp
        End If
        
        bytesSent = bytesSent + chunkSize
        
        Dim IntValue As Long
        IntValue = (bytesSent \ chunkSize)
        If IntValue >= 5 Then
            IntValue = 5
        End If
        Set prg = Forms!dlgPRGBAR!CtlProgress.Object
        Set Complete = Forms!dlgPRGBAR!lblComplete
        prg.Max = numParts
        prg.Value = IntValue
        
        strComplete = Format((prg.Value / prg.Max) * 100, "##") & " % Завершено"
        Complete.Caption = strComplete
        DoCmd.RepaintObject
    Loop

    adoStream.Close
    DoCmd.Close acForm, "dlgPRGBAR"
    
    responseStatus = xmlHttp.status
    If responseStatus = 201 Then
        MsgBox "Файл успешно загружен!", vbInformation
    Else
        MsgBox "Ошибка: " & responseStatus & " - " & xmlHttp.StatusText, vbCritical
    End If
    
CleanUp:
    On Error Resume Next
    If Not adoStream Is Nothing Then adoStream.Close
    Set adoStream = Nothing
    Set xmlHttp = Nothing
    Exit Sub
    
ErrHandler:
    MsgBox "Произошла ошибка: " & err.Description, vbCritical
    Resume CleanUp
End Sub

Ответ или решение

Чтобы успешно загрузить файл в Azure Blob Storage с использованием Microsoft.XMLHTTP в VBA и отслеживанием прогресса, предлагаю улучшить ваш код с некоторыми изменениями. Ваша ошибка, связанная с xmlHttp.send fileData, может быть вызвана неправильной передачей данных, в частности, при делении файла на части. Рассмотрим некоторые изменения и улучшения:

Обновленный код для загрузки файла с отслеживанием прогресса

Public Sub UploadToAzureBlob(filePath As String, fileName As String)
    Dim adoStream As Object
    Dim xmlHttp As Object
    Dim responseStatus As Long
    Dim sUrl As String
    Dim fileSize As Long
    Dim bytesSent As Long
    Dim chunkSize As Long
    Dim fileData() As Byte
    Dim progressForm As Form
    Dim numParts As Long

    On Error GoTo ErrHandler

    filePath = filePath & fileName
    fileName = "/" & URLEncodeJScript(fileName) ' Формат для Azure
    sUrl = blobUrl & fileName & sasToken

    ' Создание потока для чтения файла
    Set adoStream = CreateObject("ADODB.Stream")
    adoStream.Mode = 3
    adoStream.Type = 1
    adoStream.Open
    adoStream.LoadFromFile filePath

    fileSize = adoStream.Size

    ' Установление размера частей
    numParts = 5
    chunkSize = fileSize \ numParts
    If chunkSize = 0 Then chunkSize = fileSize

    DoCmd.OpenForm "dlgPRGBAR"
    Set progressForm = Forms!dlgPRGBAR

    bytesSent = 0
    Do While bytesSent < fileSize
        If bytesSent + chunkSize > fileSize Then
            chunkSize = fileSize - bytesSent
        End If

        adoStream.Position = bytesSent
        ReDim fileData(0 To chunkSize - 1)
        fileData = adoStream.Read(chunkSize)

        Debug.Print "Размер части: " & chunkSize & " Отправлено байт: " & bytesSent

        ' Инициализация запроса
        Set xmlHttp = CreateObject("Microsoft.XMLHTTP")
        xmlHttp.Open "PUT", sUrl, False
        xmlHttp.setRequestHeader "x-ms-blob-type", "BlockBlob"
        xmlHttp.setRequestHeader "Content-Length", CStr(chunkSize)

        ' Отправка данных
        xmlHttp.send fileData

        If xmlHttp.status <> 201 And xmlHttp.status <> 202 Then
            Debug.Print "Ошибка: " & xmlHttp.status & " - " & xmlHttp.StatusText
            MsgBox "Ошибка: " & xmlHttp.status & " - " & xmlHttp.StatusText, vbCritical
            GoTo CleanUp
        End If

        bytesSent = bytesSent + chunkSize

        ' Обновление прогресса
        Dim IntValue As Long
        IntValue = (bytesSent \ (fileSize / numParts))
        If IntValue >= 5 Then
            IntValue = 5
        End If
        Set prg = Forms!dlgPRGBAR!CtlProgress.Object
        Set Complete = Forms!dlgPRGBAR!lblComplete
        prg.Max = numParts
        prg.Value = IntValue

        Dim strComplete As String
        strComplete = Format((prg.Value / prg.Max) * 100, "##") & " % Завершено"
        Complete.Caption = strComplete
        DoCmd.RepaintObject
    Loop

    adoStream.Close
    DoCmd.Close acForm, "dlgPRGBAR"

    responseStatus = xmlHttp.status
    If responseStatus = 201 Then
        MsgBox "Файл успешно загружен!", vbInformation
    Else
        MsgBox "Ошибка: " & responseStatus & " - " & xmlHttp.StatusText, vbCritical
    End If

CleanUp:
    On Error Resume Next
    If Not adoStream Is Nothing Then adoStream.Close
    Set adoStream = Nothing
    Set xmlHttp = Nothing
    Exit Sub

ErrHandler:
    MsgBox "Произошла ошибка: " & Err.Description, vbCritical
    Resume CleanUp
End Sub

Основные изменения и дополнения:

Создание объекта xmlHttp внутри цикла: Теперь вы создаете новый объект xmlHttp для каждой отправки. Это позволяет избежать конфликтов при повторной отправке.
Исправление расчета значения IntValue: Правильное значение IntValue для обновления прогресса.
Оптимизация определения размеров частей: Мы используем деление размера файла на количество частей более эффективно, чтобы избежать ошибок при последней части файла.
Ошибка при отправке: Добавил вывод подробной информации, чтобы более точно узнать о статусе ответа.

Теперь ваш код должен корректно загружать файл с отслеживанием прогресса. Убедитесь, что у вас есть правильные права доступа и URL для Azure Blob Storage.