質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.35%

  • VBA

    1899questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • HTTP

    566questions

    HTTP(Hypertext Transfer Protocol)とはweb上でHTML等のコンテンツを交換するために使われるアプリケーション層の通信プロトコルです。

VBAでHttpRequestのSendメソッドを使った際にタイムアウトエラーが起こる

解決済

回答 1

投稿

  • 評価
  • クリップ 0
  • VIEW 2,892

ot2os

score 14

●やりたいこと

インターネット上のあるサイトにログインして、そこに保存されているcsvファイルを自動でダウンロードできるようにしようと思っています。
さしあたって、一番簡単そうなVBAでHttpRequestを使った方法を検討中です。

●問題(発生現象)

下記のコードを実行後、タイムアウトエラーが出ます。

Option Explicit

Public Sub Sample04()
  Dim req As Object
  Dim dat As Variant

  Const UserName = "User" 'ユーザー名
  Const PassWord = "Password" 'パスワード
  Const AuthUrl = "https://xxxx.jp/login.aspx" '認証ページのURL
  Const FileUrl = "https://xxxx.jp/logs.csv?start=2017%2f12%2f01&end=2017%2f12%2f31" 'ダウンロード対象のURL
  Const SaveFilePath = "C:\Users\User01\Documents\MyFiletest.csv"    'ローカルのダウンロード先

  Const adTypeBinary = 1
  Const adSaveCreateOverWrite = 2

  Set req = Nothing '初期化
  Set req = CreateHttpRequest()
  If req Is Nothing Then Exit Sub

  '認証
  req.Open "POST", AuthUrl, False
  dat = "__EVENTTARGET=&__EVENTARGUMENT=&__VIEWSTATE=%2dwzKFGoOuiYCVzJJPEcC0RavMKGsUBdZNkyy7CiR8fW44tJ4T1HtL3sw2TryxZF3NnFDbKUud8ZxYHRhL41C1htjjdGyPDRScI44wWxYmC1q1rFQmgug&__VIEWSTATEGENERATOR=20B48FBE&__EVENTVALIDATION=%2k6CsmGmvppDJ3c6sFZpiGzl6kovsNmuyTbSSXJZoAA2fZpbp0DjbrvU6LbUS9Av1PeGZj5ymBh&UserId=" & UserName & "&Password=" & PassWord & "&Submit=%30%B8%E2%83%E2%E3%B3%83%AD%A4%E3%83" 'パラメーター設定
  req.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  req.Send dat  '★この段階でタイムアウトエラー発生
  If req.Status <> 200 Then
    MsgBox "認証に失敗しました。" & vbCrLf & _
           "処理を中止します。", vbCritical + vbSystemModal
    Exit Sub
  End If

  'ファイルのダウンロード
  req.Open "GET", FileUrl, False
  'XMLHTTPRequestを考慮してキャッシュ対策
  req.setRequestHeader "Pragma", "no-cache"
  req.setRequestHeader "Cache-Control", "no-cache"
  req.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
  req.Send
  Select Case req.Status
    Case 200
      With CreateObject("ADODB.Stream")
        .Type = adTypeBinary
        .Open
        .Write req.responseBody
        .SaveToFile SaveFilePath, adSaveCreateOverWrite
        .Close
      End With
    Case Else
      MsgBox "エラーが発生しました。" & vbCrLf & _
             "ステータスコード:" & req.Status, _
             vbCritical + vbSystemModal
      Exit Sub
  End Select

  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub

Private Function CreateHttpRequest() As Object
'WinHttpRequest/XMLHTTPRequestオブジェクト作成
'http://www.f3.dion.ne.jp/~element/msaccess/AcTipsWinHTTP1.html 参考
  Dim progIDs As Variant
  Dim ret As Object
  Dim i As Long

  Set ret = Nothing '初期化
  progIDs = Array("WinHttp.WinHttpRequest.5.1", _
                  "WinHttp.WinHttpRequest.5", _
                  "WinHttp.WinHttpRequest", _
                  "Msxml2.ServerXMLHTTP.6.0", _
                  "Msxml2.ServerXMLHTTP.5.0", _
                  "Msxml2.ServerXMLHTTP.4.0", _
                  "Msxml2.ServerXMLHTTP.3.0", _
                  "Msxml2.ServerXMLHTTP", _
                  "Microsoft.ServerXMLHTTP", _
                  "Msxml2.XMLHTTP.6.0", _
                  "Msxml2.XMLHTTP.5.0", _
                  "Msxml2.XMLHTTP.4.0", _
                  "Msxml2.XMLHTTP.3.0", _
                  "Msxml2.XMLHTTP", _
                  "Microsoft.XMLHTTP")
  On Error Resume Next
  For i = LBound(progIDs) To UBound(progIDs)
    Set ret = CreateObject(progIDs(i))
    If Not ret Is Nothing Then Exit For
  Next
  On Error GoTo 0
  Set CreateHttpRequest = ret
End Function

上記コマンド実行後、20秒ほどしてからreq.Send dat部分で下記エラーが出ます。

「Microsoft Visual Basic」
実行時エラー'-2147012894(80072ee2)'
処理がタイムアウトになりました。

●確認したこと

1.現象発生時点で変数reqの値は各項目「<この操作を完了するのに必要なデータは、まだ利用できません>」です。

2.Internet Explorer で該当サイトを開き、「F12]キーの開発者ツール → 「ネットワーク」でログイン時の情報を収集した結果は下記

URL プロトコル メソッド 結果 種類
/login.aspx HTTPS POST 302 text/html
/edit_profile.aspx HTTPS POST 200 text/html
  • HTTPSのPOSTが2つあり、1行目の結果が302なのも気になりましたが、302は"Found"の応答のようなので特に問題なし?

  • 試しに2行目の「https://xxxx.jp/edit_profile.aspx」をAuthUrlに代入してみましたが、結果は同じくタイムアウト。

  • ちなみに、2行目の「要求本文」も1行目と全く同じ。

  • また、ステータスの確認までコードが進んでいないので、現状req.Send dat部分で引っかかる部分を何とかしたいです。

  • 変数datの内容は「要求本文」で確認した内容を使っています。
    かなり長いのが気になりましたが、送られている要求本文は毎回全く同じでした。

  • 「要求ヘッダー」の「Content-Type」は「application/x-www-form-urlencoded」でした。

  • 「要求」は「POST /login.aspx HTTP/1.1」です。

正直、他にどこを確認すれば良いのかよくわからない状態です。
確認すべき項目があれば補足いたします。

参考情報:

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

check解決した方法

0

解決しました。
コード中のSet req = CreateHttpRequest()Set req = CreateObject("Msxml2.XMLHTTP")に変えたところ、あっさり処理完了しました。

中の動作が見えませんが、ここのObject型にたくさん詰め込みすぎるとSendでタイムアウトしてしまうようです。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

同じタグがついた質問を見る

  • VBA

    1899questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • HTTP

    566questions

    HTTP(Hypertext Transfer Protocol)とはweb上でHTML等のコンテンツを交換するために使われるアプリケーション層の通信プロトコルです。