VBAプログラム開発、スクレイピング・詳細データ取得拡張【1-7】書籍情報削除エラー対処を行う
書籍情報削除のVBAについて、Web側の書籍削除処理と削除結果をワークシートへ表示まではできました。
しかし、追加・削除を繰り返し試しながら作成する中で、削除時に失敗するケースを考慮できていませんでしたので対処をおこなっていきます。
今回の目的
書籍情報削除時のエラー対処を行い、VBA動作を完了させる
なぜやるか
想定されるエラーを考慮したVBAコードとし、処理中断しないようにするため
やりたいこと
- 存在しない書籍IDを指定して削除処理するとエラーが発生することを解決する
- その他、Webアクセス時に問題が発生し、レスポンスが正常でない場合に対しての処理を追加する
やったこと
- 削除処理する書籍IDの結果パターンを確認する
- HTTPステータスコードを確認できるようにする
- HTTPステータスコードで処理分岐する
- レスポンスエラーとなったIDに対して結果を表示する
実施内容
何が問題か
同じ処理をしてエラーが発生していた
前回までの処理で完成しているのは、削除ID欄に削除したいIDを指定してVBAを実行することで、削除結果が表示されていました。
# 書籍削除結果
ここまでは問題ありません。
しかし、上記の画面のまま同じVBAをもう一度実行すると、削除IDが入力されているので、再度削除処理が実施されます。この為削除ボタンクリックの時にオブジェクトがない為、エラーとなりVBAが中断していました。
存在しないページにアクセスしても削除はできない
書籍削除VBAを使用するには、初めにワークシートにIDを入力します。入力されたIDを読み取って削除処理が動作します。
入力方式なので、削除済みのIDやまだ使用されていないIDを指定する可能性があります。
使用していないIDを指定すると…当然ながら削除済みのIDを付与したURLへアクセスしても情報がそもそもありません。
ブラウザで直接アクセスして表示確認してももちろんエラーとなります。
HTTPステータスコード500です。サーバ内部エラーが返されます。
このため、書籍削除VBAの処理結果に削除できた・削除できなかったに加えて、アクセスできませんでしたを追加する必要があります。
アクセス可否を判定する
どうやってアクセス可否判定をするか
原因が分かったところで、次はどうやって判断するかです。
まず考えたのは
- 削除ボタンがあるかどうかで判定
アクセスできていないということは書籍詳細画面が表示されていないので、オブジェクト取得に失敗しています。
そこで、削除ボタンをクリックするまえに削除ボタンがあるかどうかを判定しようというものです。
しかし、せっかくアクセスできない時にHTTPステータスコード500 が表示されているのでどうにかしてこのエラーを扱えないか…という考えに変わりました。そこで考えたのは
- アクセス先のWebページのレスポンスで判定
HTTPステータスコードが取得できれば、指定したIDのページはないという判断ができそうです。この方法がVBAで扱えるか調べてみることにしました。
HTTPリクエストとレスポンス
調べた情報を元に、HTTPステータスコードを取得する方法を現在の書籍削除VBAコードに追加してみることにしました。
作成するにあたったは、こちらを参考にさせて頂きました、ありがとうございます。
こちらをもとに、HTTPステータスコードをまずは表示します。
IXMLHTTPRequestオブジェクトを使用してHTTPリクエストを行うことでHTTPステータスを確認できるので、これをまず実装します。
# ISBN削除用プロシージャ（削除処理・HTTPリクエスト）
'削除ID毎に処理
If DelID.Count = 0 Then
ExitMsg = "削除IDがありません"
Else
i = 1 '繰り返し初期化
Dim objHTTP As Object 'HTTPチェック用オブジェクト
Dim HTTPStatus As Integer
Do
DelBookPage = DelBookPageBase & DelID(i) '削除書籍URL取得
'HTTPリクエストしてレスポンスを取得する
Set objHTTP = CreateObject("MSXML2.XMLHTTP") 'IXMLHTTPRequestオブジェクト生成
objHTTP.Open "HEAD", DelBookPage, False 'IXMLHTTPRequestオブジェクト初期化
objHTTP.send 'IXMLHTTPRequestリクエスト送信
Do While objHTTP.readyState < READYSTATE_COMPLETE '読み込み待ち
DoEvents
Loop
HTTPStatus = objHTTP.Status 'HTTPステータスコード格納
'HTTPリクエスト結果によって削除判断
～ 以下省略 ～
Loop Until i > DelID.Count
ExitMsg = "削除処理が完了しました"
End If
まず、Set objeHTTP変数としてHTTPリクエストをするためのオブジェクトを作成します。
objHTTP.sendとすることで、リクエスト送信が行われます。その後、レスポンスがobjHTTPに格納されるので、その中からHTTPステータスコードをobjHTTP.Statusとして受け取ります。
と、これでデータが受け取れるようですが実際にデータを確認します。
レスポンスを確認する
正常にアクセスできるページであればHTTPステータスコード=200となります。
アクセスできないページは結果として、500が返されていました。
# 正常アクセス時
HTTPステータスコード=200の応答が返された時の変数の内容です。
objHTTP.status=200となっています。この値をHTTPStatus変数(図内一番下)へ格納して値を後の判定に使います。
# アクセス失敗例
HTTPステータスコード=500の応答が返された時の変数内容はこちらです。
objHTTP.status=500となっています。すぐ下にステータスコードのテキスト表記もあり、"Internal Server Error"となっています。
削除対象のページにアクセスする前に、このステータスを確認すれば、削除処理を実施するしないの判断に使えそうです。
HTTPリクエスト取得処理をサブプロシージャ化する
先程作成したHTTPステータスコード取得処理を一つのプロシージャとして管理できるように変更します。
# ISBN削除用プロシージャ（削除処理・HTTPリクエスト）
Do
DelBookPage = DelBookPageBase & DelID(i) '削除書籍URL取得
'HTTPリクエストステータスを確認
Call CheckHTTPRequest(DelBookPage, HTTPStatus)
HTTPリクエストのチェックということが分かる名前にして呼び出しできるように変更しました。
# HTTPリクエスト確認プロシージャ
Sub CheckHTTPRequest(DelBookPage As String, HTTPStatus As Integer)
Dim objHTTP As Object 'HTTPチェック用オブジェクト
Set objHTTP = CreateObject("MSXML2.XMLHTTP") 'IXMLHTTPRequestオブジェクト生成
objHTTP.Open "HEAD", DelBookPage, False 'IXMLHTTPRequestオブジェクト初期化
objHTTP.send 'IXMLHTTPRequestリクエスト送信
Do While objHTTP.readyState < READYSTATE_COMPLETE '読み込み待ち
DoEvents
Loop
HTTPStatus = objHTTP.Status 'HTTPステータスコード格納
End Sub
場所を移したのみで、内容は特に変更していません。動作できるように変数の受け渡しをしてやれば問題なく動作しました。
HTTPステータスコードによって処理分岐する
HTTPステータスコードを取得できるようになったので、取得した後の処理を加えていきます。
処理分岐なので、IFで場合分けをします。
HTTPステータスコードが200の場合は、指定したURLに正常接続しているとみなして、削除処理を実行できるようにします。
そして、それ以外のコードだった場合は、処理失敗とします。
# イメージ・ISBN削除用プロシージャ（繰り返し処理）
Do
～ HTTPリクエスト処理まで実施 ～
'if 200時
～ 書籍削除コードを実行 ～
'else 200以外
'指定したサイトにアクセスできない
'End If
i = i + 1
Loop Until i > DelID.Count
イメージとしてはこのような感じで考えています。
HTTPステータスコードが200の時には書籍削除を行い、そうでなければ何らかの理由で正常でない返答を返すようにすれば、処理結果をワークシートに反映することにも対応できそうです。
実際に処理を書いてみました。
# ISBN削除用プロシージャ（削除処理ループ）
Do
DelBookPage = DelBookPageBase & DelID(i) '削除書籍URL取得
Set BookProcess = DelBookSheet.Cells(i + 1, 2) '処理結果反映セル
'HTTPリクエストステータスを確認
Call CheckHTTPRequest(DelBookPage, HTTPStatus)
'HTTPステータスコード=200なら、削除処理を実施
If HTTPStatus = 200 Then
'URLを開いてオブジェクト取得
objIE.navigate DelBookPage 'IEでURLを開く
Call WaitResponse(objIE) '読み込み待ち
Set htmlDoc = objIE.document 'objIEで読み込まれているHTMLドキュメントをセット
'書籍を消す
htmlDoc.getElementsByClassName("nav-btn delete")(0).Click
'削除後の処理
Call WaitResponse(objIE) '読み込み待ち
DelBookURLAfter = objIE.document.URL & "/" '読み込み後のURL取得
'結果をワークシートへ出力
If DelBookURLAfter = DelBookPageBase Then
DelBookSheet.Range(BookProcess.Address).Value = "削除しました"
Else
DelBookSheet.Range(BookProcess.Address).Value = "削除できませんでした"
End If
'HTTPステータスコード<>200は、エラーとして結果を返す
Else
DelBookSheet.Range(BookProcess.Address).Value = "接続エラー(" & HTTPStatus & ")"
End If
i = i + 1 '次データ処理開始準備
Loop Until i > DelID.Count
HTTPステータスコードを確認し、結果に対してIfによる処理分岐を反映させました。
HTTPステータスコードが200であった場合は、いままでの削除処理がそのまま適用されます。
一方で、200以外の場合は削除処理は一切行わずに、ワークシートへ結果だけを返すようにしました。その際、HTTPStatus変数を使用することで、HTTPステータスコードが何であったかを併せて表示させるようにしました。
削除できた・削除できなかった・アクセスできませんでしたの3つに対応できました。
HTTPステータスコードによる判断を入れることで、存在しない書籍IDのページで削除ボタンを押す動作はなくなりました。これでVBAコード実行時のエラーを回避するという目的は達成できました。
セル指定コードをまとめる
ワークシートへ出力するセル位置を繰り返し書いていることに気づいたので、一つにまとめました。
# ISBN削除用プロシージャ（抜粋）
Set BookProcess = DelBookSheet.Cells(i + 1, 2) '処理結果反映セル
DelBookSheet.Range(BookProcess.Address).Value = "削除しました"
結果を出力する内容は3箇所あり、全てにセル位置を個別に書いていたので、変数へ格納して、Addressで位置を取得しました。
これによって位置が変更になった際の修正箇所が1箇所ですみます。
最終動作確認をする
最後に、準備していた書籍情報を全部登録した状態で全書籍情報を削除させました。
全書籍IDをワークシートへ登録しておきます。所有者がいる書籍は削除失敗、存在しないIDはエラーとなった結果が返ってきます。
ID指定を完了させて、削除VBAを実行します。
削除IDさえ入力しておけば、後は全て自動的に処理してくれるようになりました。
Web上のデータについても、削除できなかった書籍のみが残っている状態です。
以上で書籍削除のエラー対処が完了しました。
