vba - 运行时错误，但仅在第二个循环中

Question

长期读者，第一次海报。不能强调这个网站对一个完全的新手有多大用处。

下面的代码通过循环遍历一列(第 11 列)中的一列日期以获取 3 组行(第 2 列)，从而形成一个 URL(然后下载文件)，

即

下载 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 时，就在下载 row2.date1 之前，它在 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)声明函数 URLDownloadToFile Lib“urlmon”别名“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

子 DownloadMe() Dim x 为整数 暗淡为整数

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}

private sub可以定义在sub downloadme()里面吗？

再次感谢!

Answer 1

不确定是什么导致了您的问题，但我想我记得我曾尝试过您在某个时候使用的“流”方法并遇到了问题。这是我最终使用的另一种方法，它对我有用:

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