运行时错误,但仅在第二个循环中

时间:2013-11-04 12:13:42

标签: vba

长期读者,第一次海报。不能强调这个网站对一个完整的新手有多么有用。

下面的代码形成一个URL(然后下载文件),循环遍历一列(第11列)中的3列行的日期列(在第2列中),

使用URL = row1.date1下载文件, 然后是row1.date2, 然后是row1.date3。 然后,row2.date1, 然后是row2.date2, 然后是row2.date3。 然后,row3.date1, 然后是row3.date2, 然后是row3.date3。

它完成了row1.date1,然后是row1.date2,然后是row1.date3,就好了。当它在下载row2.date1之前循环并启动row2时,它会在oStream.Write WinHttpReq.responseBody上生成运行时错误“3001”。 错误是:参数类型错误,超出可接受范围或彼此冲突。

我花了整个周末试图弄清楚这一点,没有运气。通过解决请让我看起来很愚蠢!我已经搜索过,似乎没有人在循环中第一次连接很好的问题,而不是第二次。如果我错过了,请发给我链接。

  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
编辑:@Cilla 太棒了!你的代码对我来说更加顺畅,谢谢!我现在必须以您的格式组合2个代码。您如何看待以下内容?你会这样做吗?:

{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}

私有子是否可以在sub downloadme()中定义?

再次感谢!

1 个答案:

答案 0 :(得分:2)

不确定可能导致您的问题的原因,但我想我记得在某些时候尝试使用'stream'方法并遇到问题。这是我最终使用的另一种方法,它对我有用:

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