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

Posted 2023-02-19

【中文标题】运行时错误，但仅在第二个循环中

【英文标题】：Run time error, but only in the second loop

【发布时间】：2013-11-15 01:26:56

【问题描述】：

长期阅读，第一次海报。不能强调这个网站对于一个完全新手来说是多么有用。

下面的代码通过在一个列（第 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 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() 将 x 调暗为整数 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()里面定义私有sub吗？

再次感谢！

【问题讨论】：

该代码对我来说很好（假设第 3 列中的文件名有唯一值）我猜这是您在第二个循环中使用的特定 url，它返回的状态为 200 但是写入流时会出错的空响应或格式错误的响应。失败案例中是否手动验证了目标url？

【参考方案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

【讨论】：

太棒了！您的代码对我来说更加流畅，谢谢！我现在必须以您的格式组合 2 个代码。你觉得我上面的编辑怎么样？谢谢！