VBA недостаточно ресурсов памяти ошибка при загрузке большого файла - PullRequest
Новая
       64

VBA недостаточно ресурсов памяти ошибка при загрузке большого файла

1 голос
/ 07 января 2020

, когда я пытаюсь загрузить большой файл (2 ГБ) с помощью этой функции, появляется эта ошибка «недостаточно ресурсов памяти для выполнения этой операции». Итак, что я могу сделать? 

Function DownloadFile(ByVal URL As String, ByVal Path As String, ByVal UserName As String, ByVal Password As String) As Boolean


    DownloadFile = False


    Const HTTPREQUEST_SETCREDENTIALS_FOR_SERVER = 0
    Dim WinHttpReq As Object
    Dim oStream As Object

    Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    WinHttpReq.Open "GET", URL, False
    WinHttpReq.SetCredentials UserName, Password, HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
    WinHttpReq.send

    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.responseBody
    oStream.SaveToFile Path, 2
    oStream.Close

    DownloadFile = True


    Set WinHttpReq = Nothing
    Set oStream = Nothing

End Function

1 Ответ

0 голосов
/ 09 января 2020

это мой код, и он работает нормально, и вы можете установить размер чанка. если у вас есть какие-либо улучшения в логи c, пожалуйста, скажите мне 

Sub Download()

  Dim UserName As String
  Dim Password As String
  Dim Path As String
  Dim url As String
  Dim chunkSize As Long


  UserName = ""
  Password = ""
  Path = ""
  url = ""
  chunkSize = 500000000 '500 mega

  Const HTTPREQUEST_SETCREDENTIALS_FOR_SERVER = 0
  Dim WinHttpReq As Object
  Dim oStream As Object
  Dim iStream As Object
  Dim totalSize As Double
  Dim currentStartByte As Double
  Dim currentEndByte As Double


  'get the total file size 
  Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
  WinHttpReq.Open "HEAD", url, False
  WinHttpReq.SetCredentials UserName, Password, HTTPREQUEST_SETCREDENTIALS_FOR_SERVER
  WinHttpReq.setRequestHeader "User-Agent", 0
  WinHttpReq.send   
  totalSize = WinHttpReq.getResponseHeader("Content-Length")
  Set WinHttpReq = Nothing


  Set oStream = CreateObject("ADODB.Stream")
  oStream.Open
  oStream.Type = 1 'adTypeBinary

 'set the initial start and end byte   
  currentStartByte = 0  
  if totalSize < chunkSize then
    currentEndByte = totalSize
  else
    currentEndByte = chunkSize
  end if

  Dim firstloop As Boolean    
  firstloop = True

  Do While (currentEndByte > currentStartByte)

    Set iStream = CreateObject("ADODB.Stream")
    iStream.Open
    iStream.Type = 1 'adTypeBinary

     'read the data from the saved file to out stream 
     If firstloop = False Then
      iStream.LoadFromFile Path
      oStream.Write iStream.Read
     End If

     'read the chunked data from the responseBody to out stream 
     Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
     WinHttpReq.Open "GET", url, False
     WinHttpReq.SetCredentials UserName, Password, HTTPREQUEST_SETCREDENTIALS_FOR_SERVER        
     WinHttpReq.setRequestHeader "User-Agent", 0
     WinHttpReq.setRequestHeader "Range", "bytes=" + Str(currentStartByte) + "-" + Str(currentEndByte)
     WinHttpReq.send
     oStream.Write WinHttpReq.responseBody

     'save out stream to the file
     oStream.SaveToFile Path, IIf(1, 2, 1)


     'set the start and end byte for the next loop
     currentStartByte = currentStartByte + chunkSize + 1 
     currentEndByte = currentEndByte + chunkSize + 1    

     'if the remaining byte less than chunk size
     If currentEndByte > totalSize Then
      currentEndByte = totalSize
     End If


     firstloop = False
     Set WinHttpReq = Nothing
     iStream.Close
     Set iStream = Nothing

   Loop

   oStream.Close
   Set oStream = Nothing

End Sub
...