Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Run time error, but only in the second loop

Tags:

vba

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!

like image 849
user2952447 Avatar asked Feb 13 '26 20:02

user2952447


1 Answers

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
like image 196
cilla Avatar answered Feb 15 '26 16:02

cilla



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!