Solved: Downloading File issues - Buffer Length invalid or not enough memory

[CodeNinja]

Hi guys,
Still trying to get my project finished. I have all the pieces, but the download is not working. It looks like the buffer length is invalid or there is not enough memory.

Initially, I thought this would handle a file up to 4 GB and the file I am trying to download is like 300K, so there should be no problem. Then, I thought maybe it is a firewall issue with our servers, so I tried to download on my desktop... still no luck.

Anyone know what I am doing wrong?

Attached is the program (I am using cpearson's download file routine which can be seen at: http://www.cpearson.com/excel/downloadfile.aspx )

Attached is the program. A sample of a file I am trying to download is:

http://test2.hyattselectreports.lraqa.com/hyattselect_report_generation/PL1.php?r=aW5zcF9pZD0zNDMxNCZkaXNwbGF5PXRydWUmbGFuZ3VhZ2U9ZGVmYXVsdA==

Thanks so much.

Josh / CodeNinja

[Kenneth Hobs]

Option Explicit

Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" ( _
ByVal lpszUrlName As String) As Long

Const ERROR_SUCCESS As Long = 0
Const BINDF_GETNEWESTVERSION As Long = &H10
Const INTERNET_FLAG_RELOAD As Long = &H80000000
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Function DownloadFile(sSourceURL As String, _
sLocalFile As String) As Boolean
'Dim sLocalFile As String

'Download the file. BINDF_GETNEWESTVERSION forces
'the API to download from the specified source.
'Passing 0& as dwReserved causes the locally-cached
'copy to be downloaded, if available. If the API
'returns ERROR_SUCCESS (0), DownloadFile returns True.
DeleteUrlCacheEntry sSourceURL
DownloadFile = URLDownloadToFile(0&, _
sSourceURL, _
sLocalFile, _
BINDF_GETNEWESTVERSION, _
0&) = ERROR_SUCCESS
End Function

Sub Test_DownloadFile()
Dim fn As String
fn = Environ("temp") & "\ken.pdf"
DownloadFile "http://test2.hyattselectreports.lraqa.com/hyattselect_report_generation/PL1.php?r=aW5zcF9pZD0zNDMxNCZkaXNwbGF5PXRydWUmbGFuZ3VhZ2U9ZGVmYXVsdA==", fn
Shell "cmd /c " & fn, vbNormalFocus
End Sub

[CodeNinja]

First, thanks to Kenneth. Although your solution did not work in my case, I was able to use some of the code you provided to come up with the ultimate solution that worked for me, so thank you very much for your help.

In case this can be of any use to anyone else I have posted the solution to my problem. The code below will save a file from the web into a specified folder. The file from the web has to be the kind that when you click on that link, it opens a dialog box asking you where you want to save it.

It requires inputs of sURL (the url of the download) and sSavepath (where you want to save the file to). I have commented out the message box for download successful to streamline the process for my needs, but in test that was useful.


Private Declare Function URLDownloadToFileA Lib "urlmon.dll" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Private Sub DownloadFile(sURL As String, sSavePath As String)
' this will download the file.

Const E_OUTOFMEMORY As Long = &H8007000E
Const E_DOWNLOAD_FAILURE As Long = &H800C0002

Dim InitialName As String
Dim sMsg As String
Dim RegExp As Object
Dim RetVal As Long

Set RegExp = CreateObject("VBScript.RegExp")
RegExp.IgnoreCase = True
RegExp.Pattern = "^(.*\/)(.+)$"
InitialName = RegExp.Replace(sURL, "$2")
Set RegExp = Nothing

If InitialName = "" Or InitialName = sURL Then
MsgBox "Error - Missing File Name"
Exit Sub
End If

RetVal = URLDownloadToFileA(0&, sURL, sSavePath, 0&, 0&)
sMsg = ""
Select Case RetVal
Case 0
'Msg = "Download Successful"
Case E_OUTOFMEMORY
sMsg = "Error - Out of Mmemory"
Case E_DOWNLOAD_FAILURE
sMsg = "Error - Bad URL or Connection Interrupted"
Case Else
sMsg = "Unknown Error - " & RetVal
End Select

If Len(sMsg) > 0 Then MsgBox sMsg

End Sub

[pcuaron]

I don't understand the solution, now how CodeNinja solved the issue. Could you please explain it?

Thanks!