3

長年の読者、初めてのポスター。このサイトが完全な初心者にとってどれほど有用であったかを強調することはできません.

以下のコードは、1 つの列 (列 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' が生成されます。互いに対立しています。

私はこれを理解するために週末全体を費やしましたが、運がありませんでした。解いてバカにしてください！私は検索しましたが、ループで最初に接続が問題なく、2回目はそうではないという問題を抱えている人は誰もいないようです。これを見逃した場合は、リンクを送ってください。

  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}

プライベート サブはサブ 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 に答える