3

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

下面的代码通过在一个列（第 11 列）中为 3 组行（在第 2 列中）循环一列日期来形成一个 URL（然后下载文件），

IE

下载 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() 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() 中定义私有子吗？

再次感谢！

4

1 回答 1

2

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

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
于 2013-11-08T01:54:56.010 回答