Run time error, but only in the second loop

Question

Long time reader, first time poster. Can't stress how useful this site has been for a complete novice.

Code below forms a URL (which then downloads file) by looping through a column of dates in one column (column 11) for 3 sets of rows (in column 2),

i.e

download file with URL = row1.date1, then row1.date2, then row1.date3. Then, row2.date1, then row2.date2, then row2.date3. Then, row3.date1, then row3.date2, then row3.date3.

It completes row1.date1, then row1.date2, then row1.date3, just fine. The when it loops and starts row2, just before it downloads row2.date1, it produces run-time error '3001' at oStream.Write WinHttpReq.responseBody The error is: Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another.

I've spent the whole weekend tryng to figure this, with no luck. Please make me look stupid by solving! I've searched, and no one seems to have the problem where connection is fine first time around in the loop, and not so, the second. Please send me link if I have missed this.

  Sub download_file()
  Dim myURL As String
  Dim y As Integer
  Dim row As Integer

  row = 1

  Do
    y = 1

    Do
      myURL = "XXXXXX" & Cells(row, 2) & "XXXXXX" & Cells(y, 11)
      Dim WinHttpReq As Object
      Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
      WinHttpReq.Open "GET", myURL, False
      WinHttpReq.send
      myURL = WinHttpReq.responseBody

      If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1 
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile ("Z:\XXXX\" & Cells(row, 3) & Cells(y, 11) & ".txt.gz")
        oStream.Close
      End If

      y = y + 1
    Loop Until Len(Cells(y, 11)) = 0

    row = row + 1
  Loop Until Len(Cells(row, 2)) = 0
End Sub

EDIT: @Cilla Fantastic! Your code has been far smoother for me, thanks! I now have to combine 2 codes, in your format. What do you think of this below? Would you do it this way?:

{ Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller1 As Long, ByVal szURL1 As String, ByVal szFileName1 As String, ByVal dwReserved1 As Long, ByVal lpfnCB1 As Long, ByVal pCaller2 As Long, ByVal szURL2 As String, ByVal szFileName2 As String, ByVal dwReserved2 As Long, ByVal lpfnCB2 As Long) As Long

Sub DownloadMe() Dim x As Integer Dim y As Integer

y = 1

Do

Dim strGetFrom1 As String, strSaveTo1 As String, strURL1, intResult As Long
strURL1 = "AAAAA" & Cells(y, 1) & "BBBBB" 
strSavePath1 = "C:\test\" & Cells(y, 1) & ".csv"
myResult = URLDownloadToFile(0, strURL1, strSavePath1, 0, 0, 0, 0, 0, 0, 0)
If intResult <> 0 Then MsgBox "Oops!  There was an error with iOS"

y = y + 1

Loop Until Len(Cells(y, 1)) = 0



x = 1

Do

y = 1

Do

Dim strGetFrom2 As String, strSaveTo2 As String, strURL2, intResult As Long
strURL2 = "MMMMM" & Cells(x, 2) & "NNNNN" & Cells(y, 3) & "PPPPP" 
strSavePath2 = "C:\test\" & (y, 3) & ".csv"
myResult = URLDownloadToFile(0, 0, 0, 0, 0, 0, strURL2, strSavePath2, 0, 0)
If intResult <> 0 Then MsgBox "Oops!  There was an error with iOS"

y = y + 1
Loop Until Len(Cells(y, 3)) = 0


x = x + 1
Loop Until Len(Cells(x, 2)) = 0

End Sub}

Could the private sub be defined inside sub downloadme ()?

THANKS AGAIN!

That code works fine for me (assuming there are unique values in column 3 for the file name) I would guess that it's the specific url you use on the second loop around that's returning a status of 200 but either an empty or malformed response which would error when written to the stream. Have you manually verified the target url in the failure case? — Alex K.

cilla cilla · Accepted Answer · 2013-11-08T01:54:56

Not sure what might be causing your problem, but I think I remember trying the 'stream' method you used at some point and ran into issues. Here's a different method I ended up using that did work for me:

Private 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

Sub DownloadMe()
Dim strGetFrom As String, strSaveTo As String, intResult As Long
strURL = "http://mydata.com/data-11-07-13.csv"
strSavePath = "C:\MyUser\Desktop\data-11-07-13.csv"
myResult = URLDownloadToFile(0, strURL, strSavePath, 0, 0)
If intResult <> 0 Then MsgBox "Oops!  There was an error!"
End Sub

Run time error, but only in the second loop

1 Answers