今までと大きく毛色が違います。
概要
WEBからCSVをダウンロードして、それを取り込んでEXCELの表を更新してたのですが、そのマクロの作成で苦労したのでhttpの解析の方法と合わせて書いておきます。
同じようなことをしたい人の参考になればいいかな。
「Microsoft Internet Controls」ではファイルのダウンロードはできない
EXCELでスクレイピングするのに最初に試したのは「Microsoft Internet Controls」でした。
これを使うとIEが表示されます。そのため、処理中に表示されているIEをを操作すると影響を受けて処理に失敗したり、操作しない場合でもフレームがわかれていたりするとその後ドキュメントが取れなくなったり、操作が実行できなくなったりします。完全にはコントロールしきれませんでした。
極めつけは、ダウンロード時に表示されるダイアログが処理できないのでCSVを完全に自動でダウンロードできないことがわかりました。
「Microsoft HTML Object Library」と「Microsoft XML, v6.0」を使う
IEを使わずhttpを直接操作する方法ということで、この2つを使ってファイルのダウンロードはできたのですが、ちょっと癖が有ったりバグっぽいものがあったりします。
スクレイピングのVBA
まずは参照設定
参照設定なしの方法もありますが、自動補完を使いたいので参照設定して使ってます。
「Microsoft HTML Object Library」と「Microsoft XML, v6.0」を参照設定してください。
GET処理
GETは以下の様にしました。
このソースは後程クラスとして全体を記述しますので、利用している関数はそちらで確認してください。
Public Function SendGet(ByRef responseText As String) As Long
Dim httpReq As XMLHTTP60
Dim params As String
' HTTPリクエストオブジェクトの作成
Set httpReq = New XMLHTTP60 => 1.
'パラメータの作成
params = CreateParameters() => 2.
' GETでオープン
httpReq.Open "GET", sendURL & "?" & params , False => 3.
'GETの送信
httpReq.send => 4.
' 処理結果待ち => 5.
Do While httpReq.readyState < 4
DoEvents
Loop
responseText = httpReq.responseText => 6.
SendGet = httpReq.Status => 7.
End Function
1.「XMLHTTP60」オブジェクトを作成します。
2.パラメータの作成ここでは別のメソッドで作成してます。このメソッドの返値は<パラメータ名>=<パラメータの値>を「&」で複数結合したものになります。
3.GETで接続（sendURL には送信先のURLが設定されています。）パラメータは、URLに「?」を付けてパラメータを追加します。
4.GETの送信
5.「XMLHTTP60」の「readyState」 が4以上ならレスポンスが返ったことになるので、そこまで待ちます。
6.結果文字列を関数の引数に設定して返してます。この関数を呼び出した側で、処理しましょう。
7.HTTPの結果コードを返します。基本「200」が成功です。それ以外のHTTPのレスポンスが知りたければネットで探してください。
POST処理
POSTは以下の様にしています。
Public Function Post(ByRef responsText As String) As Long
Dim httpReq As XMLHTTP60
Dim fileHandle As Integer
Dim formData As String
' HTTPリクエストオブジェクトの作成
Set httpReq = New XMLHTTP60
'POSTでオープン
httpReq.Open "POST", sendURL, False => 1.
'httpヘッダの設定（送信形式の設定）=> 2.
httpReq.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'パラメータの送信
formData = CreateParameters()
httpReq.send formData => 3.
' 処理結果待ち
Do While httpReq.readyState < 4
DoEvents
Loop
responsText = httpReq.responseText
Post = httpReq.Status
End Function
基本的にはGETと大きく変わりませんので、変わっているところだけ示すと。
1. 見てのとおり、「GET」が「POST」に代わってます。
2. 送信データの形式を指定しています。ファイルのアップロードは考えてないので「application/x-www-form-urlencoded」です。
3. フォームの内容はsendメソッドの引数になっています。GETの様にURLに付けても送信できます。（受け取る際の違いはいまいちわかってないのですが、混ぜて送信しているものもあったりしますので、このあたりは解析したhttpリクエストに合わせておくのが無難かと思います。）
ファイルダウンロードの場合
ファイルダウンロードの場合はレスポンスがファイルそのものなので、そのままファイルに出力します。以下の例はレスポンスである「responsText」を<ファイルパス> で指定したファイルパスに出力してます。テキストしか想定していませんので、バイナリの場合は頑張って変更してください。
fileHandle = FreeFile()
Open <ファイルパス> For Output As #fileHandle
Print #fileHandle, responsText
Close fileHandle
パラメータのエンコード
パラメータはURLエンコードする必要があります。
ここではパラメータの名前と値はそれぞれ配列「formItemName」と「formItemValue」に、パラメータの個数は「formItemCount」に設定されています。
エンコードはExcelの関数である「EncodeURL」を利用して変換しています。
Private Function CreateParameters() As String
Dim params As String
Dim index As Integer
Dim xlApp: Set xlApp = CreateObject("Excel.application")
' フォームデータなしの場合は空を返す
If formItemCount = 0 Then
CreateParameters = ""
Exit Function
End If
' フォームデータ文字列を作成して返す
params= ""
For index = 0 To formItemCount - 1
params= params& "&" & formItemName(index) & "=" & xlApp.WorksheetFunction.EncodeURL(formItemValue(index))
Next index
CreateParameters = Mid(params, 2)
End Function
いろいろと気になること
基本的なヘッダ情報やクッキー処理は勝手にやってるみたい
さて、ここでhttpのリクエストをガシガシ書いている人にはヘッダ情報がほとんど書かれていないのが気になると思います。私も気になりました。
どうも、このクラスはそのあたりの基本的なものは勝手にやっているようです。基本はPOSTの「Content-Type」を設定するだけで動作します。（無しでも大丈夫かも？試してません）。
通信を調べていないので確実ではありませんが、ログイン認証があってもその後うまく動作することから、クッキー処理などの多くの事は自動でしているみたいなので、うまく動かない場合のみヘッダ情報の追加を検討しましょう。私が作った物では「Content-Type」以外、指定する必要はありませんでした。それよりは、後述するhttpの解析で動作を予想するほうが難しかったです。
リダイレクトも勝手にやってるみたい
もう一つこの「XMLHTTP60」オブジェクトの特徴としては、リダイレクトは勝手にしてしまうということです。リダイレクトのレスポンスは受け取れません。（方法があるのかもしれませんが、見つけてません）
httpを解析すると認証後にリダイレクトしていて、その前に認証のキーをクッキーで取得といったことが有ったりするのですが、勝手にリダイレクトしていてリダイレクト前の情報は取得できませんでした。でも認証後の動作は正しく動作しますので、クッキーなどは気にしなくていいみたいです。
JavaScriptは動かない、関連ファイルは取得しない
まあ、これは当然ですがJavaScriptは動作しません。そのため、JavaScript内で呼び出したPOSTは別途実行する必要がある場合があります（基本は同じ動作をさせて、不要そうなものを削って動作するなら余計な呼び出しを減らすことができます。処理によってはサーバー側でセッションとして保持している事があるので、とりあえず同じ動作をさせたほうが無難です）。
また、基本のHTTPレスポンス以外は取得しません。たとえば、htmlの中にあるスクリプトのソースファイルやimgタグの実ファイルは取得しません。ファイルダウンロードを目的とするなら、余分な通信は減らした方がいいので、わざわざとる必要はありません。
HTMLDocumentはバグってる
レスポンスをファイルとして出力する場合はそのままファイルに出力すればいいのですが、htmlとして解析して使いたい場合は、「HTMLDocument」にして、getElementXXXX系のメソッドを利用したいと思います。
ところがここに大きな落とし穴が...。
Dim doc As HTMLDocument
dim hogeValue as string
doc = new HTMLDocument
doc.write <取得したレスポンス>
hogeValue = doc.getElementByID("hoge").value
上記の処理しようとすると、「doc.write」で実行時エラーになります。
どうもバグくさいというか、コンポーネントの処理とかぶってしまってダメみたいです。
そこで、宣言時に「HTMLDocument」ではなく「Object」にすると不思議なことに実行できます。コーディング時は「HTMLDocument」にしてインテリセンスを使い、実行前に「Object」にして実行させるのがお勧めです。
httpの解析(Edge(chromium版))
この方法でスクレイピングする場合、ブラウザがどのような通信をしているか確認する必要があります。
ここでは、Edgeの機能を使って解析する方法を簡単に書いておきます。
開発者ツールの利用
最近のブラウザはほぼ開発者用のツール機能があるのでそれを利用する必要があります。私は基本Windowsですので、Edgeの開発者ツールを使った方法を簡単に書いておきます。Edgeも今はエンジンが「chromium」になっているので、Chromeでもほぼ同じ様に使えます。
Edgeでは右上の「・・・」から開発者ツールを選びます。
ウィンドウの右側に開発者ツールが開きます。
通信を見る
通信内容は開発者ツールの上のメニューから「Network」を選択します。
上部のアイコンに通信の取得のオンオフ、結果リストの消去などがあります。
基本「Type」が「document」の通信を調べます。
「Name」をクリックするとその通信の情報が表示されます。通信内容は分類されていて「Header」から以下の内容を確認してスクレイピングに利用します。
・URL
「General」の「Request URL」に入っています。URLに付加されているクエリー文字列もそのまま入っていますので参考にします。
・パラメータ
URLについているクエリー文字列は「Query String Parameters」に表示されます。「view source」にすると実際に送信している文字列を「view parse」では一覧表示になります。
POSTの場合のフォームデータは「Form Data」に表示されます。これも「view source」にすると実際に送信している文字列を「view parse」では一覧表示になります。
エレメントの確認
「Network」の「Response」から、通信で取得したデータを見ることができますが、画面表示のエレメントンとの対応を見たい場合は、「Network」ではなく「Elements」を選ぶと、タグが表示されます。この画面ではマウスを当てたタグの範囲がブラウザで強調されるので、こちらで内容を確認するといいと思います。
引っかかったところ
「payload」ってなんじゃ？
POSTのformデータでリクエストパラメータが「payload」となっている場合があります。「payload=XXX」で設定してもうまくいきません。どうもjavaScriptでデータを取ってきて、次のPOSTのformデータで利用しているようなのですが...。
何のことはない、「aaa=xxx」の形式ではなく、データをそのまま書き込んだデータでした。（私の場合は検索するためのキー配列で ["999999"] というデータでした。）この場合、sendメソッドの引数にダイレクトにその文字列を記述します。
結構変な通信してるものもある
処理の中にはGETやPOSTするとformタグぐらいしかないページで、javaScriptですぐにPOSTしている処理が有ったりしました。そのformタグにactionが設定されており、そこに処理で利用するサーバー側のキーが入っていました。
ほかにも取得するキー情報をjavaScriptで取得していたり、いろいろあります。
おそらく使っているフレームワークに起因するものもあると思いますが、機械的にされると何やってるかわかりにくいです。頑張って解析しましょう。
処理用のクラスの参考
処理用のクラスを以下の様に作ってみました。ご参考まで。
なお、postでダウンロードするときにCSVがSJISだったので文字コードの変換を入れてます。
Option Explicit
'****************************************************************************************************
' HTTP POST送信クラス
' 【使い方】
' １．このクラスのインスタンスを作成
' set util = new clsHttpUtil
' ２．送信先ＵＲＬを設定
' util.SetURL "送信先のURL"
' ３．パラメータを追加
' utile.AddParameter "パラメータ名","パラメータの値"
' ４．送信 responseTextにhtmlが返ってくる、responseCodeにはhtmlレスポンスが返ってくる
' ４－１ GET
' responseCode = utile.SendGet(responseText)
' ４－２ Getによるダウンロード
' responseCode = utile.GetandDownload( "保存先ファイルパス")
' ４－３ POST送信
' responseCode = utile.SendPost(responseText)
' ４－３ POST送信(クエリパラメータ以外)
' responseCode = utile.SendPostPayload( "クエリパラメータ以外のデータ" ,responseText)
' ４－５ Postによるダウンロード
' responseCode = utile.PostAndDownload("保存先ファイルパス")
'****************************************************************************************************
'================================================================================
' 内部変数
'================================================================================
Private httpReq As XMLHTTP60 ' http送信用オブジェクト
Private sendURL As String ' 送信先URL
Private formItemCount As Integer ' クエリパラメータの個数
Private formItemName() As String ' クエリパラメータの名前の配列
Private formItemValue() As String ' クエリパラメータの値の配列
'================================================================================
' コンストラクタ
'================================================================================
Sub class_initialize()
formItemCount = 0
Set httpReq = New XMLHTTP60
End Sub
'================================================================================
' 公開メソッド
'================================================================================
'----------------------------------------------------------------------
' POST送信するURLを設定（パラメータが初期化される）
' 【引数】
' url 設定するURL
'----------------------------------------------------------------------
Public Sub SetURL(url)
sendURL = url
formItemCount = 0
Erase formItemName
Erase formItemValue
End Sub
'----------------------------------------------------------------------
' 送信するクエリパラメータを追加
' 【引数】
' itemName クエリパラメータの名前
' itemValue クエリパラメータの値
'----------------------------------------------------------------------
Public Sub AddParameter(itemName As String, itemValue As Variant)
ReDim Preserve formItemName(formItemCount)
formItemName(formItemCount) = itemName
ReDim Preserve formItemValue(formItemCount)
formItemValue(formItemCount) = itemValue
formItemCount = formItemCount + 1
End Sub
'----------------------------------------------------------------------
' GET送信
' 【引数】
' responsText POST結果のテキスト本文を返す
' 【返値】
' GET結果（httpリクエスト結果コード）
'----------------------------------------------------------------------
Public Function SendGet(ByRef responseText As String) As Long
Dim formData As String
' HTTPリクエストオブジェクトの作成
Set httpReq = New XMLHTTP60
'パラメータの送信
formData = CreateParameters()
' GETでオープン
httpReq.Open "Get", sendURL & "?" & formData, False
'の送信
httpReq.send
' 処理結果待ち
Do While httpReq.readyState < 4
DoEvents
Loop
' 結果の取得
responseText = httpReq.responseText
SendGet = httpReq.Status
End Function
'----------------------------------------------------------------------
' GETによるファイルのダウンロード
' downloadPath ダウンロードするファイルパス
' 【返値】
' GET結果（httpリクエスト結果コード）
'----------------------------------------------------------------------
Public Function GetandDownload(downloadPath As String) As Long
Dim fileHandle As Integer
' GETでオープン
httpReq.Open "GET", sendURL, False
'パラメータの送信
httpReq.send
' 処理結果待ち
Do While httpReq.readyState < 4
DoEvents
Loop
' ファイルの作成
fileHandle = FreeFile
Open downloadPath For Output As #fileHandle
Print #fileHandle, httpReq.responseText
Close fileHandle
' 結果の取得
GetandDownload = httpReq.Status
End Function
'----------------------------------------------------------------------
' POST送信
' 【引数】
' responsText POST結果のテキスト本文を返す
' 【返値】
' POST結果（httpリクエスト結果コード）
'----------------------------------------------------------------------
Public Function SendPost(ByRef responsText As String) As Long
Dim fileHandle As Integer
Dim formData As String
' POSTでオープン
httpReq.Open "POST", sendURL, False
' httpヘッダの設定
httpReq.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'パラメータの送信
formData = CreateParameters()
httpReq.send formData
' 処理結果待ち
Do While httpReq.readyState < 4
DoEvents
Loop
' 結果の取得
responsText = httpReq.responseText
SendPost = httpReq.Status
End Function
'----------------------------------------------------------------------
' POST送信（クエリ文字列形式以外）
' 【引数】
' payload クエリ形式でないPOST送信のデータ
' responsText POST結果のテキスト本文を返す
' 【返値】
' POST結果（httpリクエスト結果コード）
'----------------------------------------------------------------------
Public Function SendPostPayload(payload As String, ByRef responsText As String) As Long
Dim fileHandle As Integer
Dim formData As String
'POSTでオープン
httpReq.Open "POST", sendURL, False
' httpヘッダの設定
httpReq.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
' ペイロードの送信
httpReq.send payload
' 処理結果待ち
Do While httpReq.readyState < 4
DoEvents
Loop
' 結果の取得
responsText = httpReq.responseText
PostPayload = httpReq.Status
End Function
'----------------------------------------------------------------------
' POSTによるファイルのダウンロード
' 【引数】
' downloadPath ダウンロードするファイルパス
' 【返値】
' POST結果（httpリクエスト結果コード）
'----------------------------------------------------------------------
Public Function PostAndDownload(downloadPath As String) As Long
Dim fileHandle As Integer
Dim formData As String
Dim i As Long
Dim s As String
' POSTでオープン
httpReq.Open "POST", sendURL, False
' httpヘッダの設定
httpReq.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
'パラメータの送信
formData = CreateParameters()
httpReq.send formData
' 処理結果待ち
Do While httpReq.readyState < 4
DoEvents
Loop
' 文字列の形式を SHIFT-JIS に変換
fileHandle = FreeFile
With CreateObject("ADODB.Stream")
.Mode = 3 'adModeReadWrite
.Open
.Type = 1 ' adTypeBinary
.write httpReq.responseBody
.Position = 0 ' .Typeを変更するため0にする必要がある
.Type = 2 'adTypeText
.Charset = "Shift_JIS"
s = .ReadText
.Close
End With
' ファイルに主強く
Open downloadPath For Output As #fileHandle
Print #fileHandle, s
Close fileHandle
' 結果の取得
PostAndDownload = httpReq.Status
End Function
'================================================================================
' 内部処理
'================================================================================
'----------------------------------------------------------------------
' URLエンコード済みのクエリパラメータを返す(EncodeURLは2013以降でないと動作しないので注意！)
' 【返値】
' URLエンコード済みのクエリパラメータ
'----------------------------------------------------------------------
Private Function CreateParameters() As String
Dim formData As String
Dim index As Integer
Dim fileHandle As Integer
Dim xlApp: Set xlApp = CreateObject("Excel.application")
' フォームデータなしの場合は空を返す
If formItemCount = 0 Then
CreateParameters = ""
Exit Function
End If
' フォームデータ文字列を作成して返す
formData = ""
For index = 0 To formItemCount - 1
formData = formData & "&" & formItemName(index) & "=" & xlApp.WorksheetFunction.EncodeURL(formItemValue(index))
Next index
CreateParameters = Mid(formData, 2)
End Function
次回
その次にはExcelでteratermのマクロを動的に作成して処理させる方法を書く予定です。