ディズニーの値上がりが激しすぎて庶民には高値の華ニャー
まえおき
最近の物価情報には目を見張るものがありますが、特にディズニーランドは5000円の入場料が6割増しの8000円になったかと思ってたら、時価制度（買うタイミングによって変動する仕組み）になったりと、どんどん庶民には遠い存在になりつつあります。
それでも小さいお子様をお持ちの家庭なら、子供が「ディズニーランドに遊びに行きたい」という願いは叶えてあげたく、大変悩ましいところだと思います。
そこで！今回は関東ＩＴＳでお得にディズニーに行く方法を伝授しようと思います。
関東ＩＴＳには健保大会というものが年1回開催されていて、大人チケットで4000円引き、小学生までのチケットで2000円引きと、とてもお得にディズニーチケットを購入できる仕組みが存在します。
ただし、年一回と行っても時期は確定しておらず、申込期間も10日間ほどしか無いので、見逃してしまって行けない人がほとんどではないかと思います。私も直近3年間見逃しています。
そこで！トゥットゥルー～～～
ＶＢＡ式健保大会チェックツール～～～
今回は、ＶＢＡを使って毎日決まった時間に関東ＩＴＳの健保大会が募集していないかチェックするツールを作成したいと思います。
前準備
ＶＢＡでＷＥＢブラウザを操作するためには、ライブラリファイルを２つ追加する必要があります。
まずVBAのコードの画面を開きます。（Alt＋F11でショートカット）
VBAのコードの画面から「ツール」＞「参照設定」を選択します。
「Microsoft Internet Controls」にチェックを入れます。
「Microsoft HTML Object Library」にチェックを入れます。
「OK」を押して画面を閉じます。
これで必要なライブラリの準備ができました。
設定画面作成
今回はスケジュールによる自動実行を行うマクロなので、設定画面は要らないのですが、可変の部分を外だししておいた方が初心者に優しく使い勝手が良いので、設定画面を作成します。
画面のイメージはこのような感じです。
本来であれば、検索対象となるページも外だししたかったのですが、コード内にベタ打ちしないと動作しなかったため、ここは妥協しました。
検索ワード
ページ内でどのようなキーワードを探すか指定します。ディズニー割引を狙っているので、今回は「健保大会」を探します。
動作確認のためにテストとして「フットサル」に書き換えて試行する事をオススメします。
セルの指定は縦４横２なのでSheets(”設定”).Cells(4,2)となります。
テキストタイトル
検索がヒットした時に作成するテキストのタイトルです。取りえず目立てば良いので「★★★★★★健保大会ディズニー★★★★★★」としています。
セルの指定は縦5横２なのでSheets(”設定”).Cells(5,2)となります。
テキスト作成場所
検索がヒットした時に作成するテキストの作成場所です。目立つようにデスクトップを指定する事をオススメします。私の場合は「81906」ですが、各自のアカウントに合わせて変更してください。
セルの指定は縦6横２なのでSheets(”設定”).Cells(6,2)となります。
コード作成
メインコード
メインコードです。ここから他のコードを呼び出して使います。
本当は検索するページを[SiteName]として、UrlIE(SiteName)とすることで外だししたかったのですが、動作しなかったためコメントアウトして、このコードに直接記載しています。
検索するサイトを変える場合はUrlIE()のカッコ内にURLを記載します。
Sub MakeIchiran()
‘SiteName = Sheets(“設定”).Cells(3, 2) ‘検索したいページ
Dim objie As Object
Set objie = UrlIE(“https://www.its-kenpo.or.jp/NEWS/event_shisetsu/index.html“) ‘検索したいページ
Call Ichiran_Make(objie)
Application.Wait (Now + TimeValue(“0:00:03”))
objie.Quit
Call KeyAndMailEnd Sub
[Call XXX]で他のコードを呼び出します。
Application.Wait (Now + TimeValue(“0:00:03”))は3秒待たせているだけです。
ファンクションUrlIE
Function UrlIE(UrlTarget As String) As Object
Dim ie As Object
Set ie = CreateObject(“InternetExplorer.Application”)ie.Visible = False
ie.navigate UrlTargetDo While ie.Busy = True Or ie.readyState <> 4
DoEvents
Loop
Set UrlIE = ie
End Function
ie.Visible = False ブラウザ表示を見える状態にする設定です。Falseにして表示させない設定としています。
Do While ie.Busy = True Or ie.readyState <> 4
DoEvents
Loop
ブラウザが完全に読み込まれるまで待ちます。ブラウザが読み込まれたらBusyプロパティがFalse、またはReadyStateプロパティが4になるので、それまでLoopさせています。DoEventsを設定する事で無限ループでフリーズ状態となった場合にEscで抜け出せるようにしています。
要素抜出しコード
Sub Ichiran_Make(objie As Object)
Dim el As Object
Dim n As LongSheets(“一覧”).Select
Cells.ClearContents
Cells.ClearContents 一覧シートのデータを作業前に全削除します。
‘タイトル入力
Cells(1, 1) = “No.”
Cells(1, 2) = “TypeName”
Cells(1, 3) = “tagName”
Cells(1, 4) = “outerHTML”
Cells(1, 5) = “innerHTML”
Cells(1, 6) = “outerText”
消してしまうので無くても良いのですが、1行目にタイトルを入力します。
‘幅指定
Cells(1, 1).ColumnWidth = 5.63
Cells(1, 2).ColumnWidth = 9.63
Cells(1, 3).ColumnWidth = 4.75
Cells(1, 4).ColumnWidth = 12.38
Cells(1, 5).ColumnWidth = 12.38
Cells(1, 6).ColumnWidth = 12.38
消してしまうのでやらなくても良いのですが、セルの幅を調整しています。
For Each el In objie.document.all
n = n + 1
Cells(n + 1, 1) = n
Cells(n + 1, 2) = “‘” & TypeName(el) ‘TypeNameでオブジェクトのタイプを表示
Cells(n + 1, 3) = “‘” & el.tagName ‘タグの名前
Cells(n + 1, 4) = “‘” & Left(el.outerHTML, 256)
Cells(n + 1, 5) = “‘” & Left(el.innerHTML, 256)
Cells(n + 1, 6) = “‘” & Left(el.outerText, 256)
Next el
End Sub
ブラウザからオブジェクトを読み込んでセルに書き込んでいます。
それぞれタイトルの通りですが①No②TypeName③tagName④outerHTML⑤innerHTML⑥outerTextとなります。
データがあった場合にテキストファイルを作成するコード
Sub KeyAndMail()
SerchKey = Sheets(“設定”).Cells(4, 2) ‘検索ワード
FileTitle = Sheets(“設定”).Cells(5, 2) ‘テキストタイトル
DESK = Sheets(“設定”).Cells(6, 2) ‘テキスト作成場所
設定画面で設定した内容をそれぞれ読取ります。
For i1 = 4 To 6
For i2 = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i2, i1) Like “*” & SerchKey & “*” Then
Body1 = i2 & “行” & i1 & “列” & Cells(i2, i1) & vbCrLf & Body1
End If
Next i2
Next i1
For文で4列から6列まで、1行目から最終行まで繰り返し処理を実施します。
If Cells(i2, i1) Like “*” & SerchKey & “*” Then 検索ワードを含む文字が出た場合
Body1 ＝ i2 ＆ ”行” ＆ i1 ＆ ”列” ＆ Cells（i2, i1） ＆ vbCr Body1に対象の行、列とセルの値を書き込みます。繰り返し処理で、複数検索にヒットした場合は改行コードvbCrの前に新たなデータが追記されます。
If Body1 <> “” Then
‘ファイルを書き込みで開く(無ければ新規作成される、あれば上書き)
Open DESK & “\” & FileTitle & “.txt” For Output As #1
‘開いたファイルに書き込む
Print #1, Body1
Close #1End If
End Sub
Body１が空でない（検索がヒットした）場合はファイルを作成します。
本来であれば、メールを送付したかったのですが、妥協して、デスクトップにファイルを作る事にしました。
VBAの手動実行ではメール送付まで成功していたのですが、自動実行した場合にエラーとなって解決の目途が立たなかったため、コメントアウトしています。参考までに作成したコードはこのようになっています。
‘ ‘OutlookのMailitemオブジェクトを取得する
‘ Dim objOutlook As New Outlook.Application
‘ Dim objMailitem As Outlook.MailItem
‘ Set objMailitem = objOutlook.CreateItem(olMailItem)
‘
‘ ‘メールの各種設定をする
‘ With objMailitem
‘ .To = “yamada.tarou@gmail.com” ‘宛先
” .CC = “yyyyyyyy@gmail.com” ‘CC
‘ .Subject = SerchKey & “を発見しました” ‘件名
‘ .body = Body1 ‘本文
” .display ‘新規メール画面を表示
‘ .send ‘メールを送信
‘ End With
試してみたい方は「Microsoft Outlook XX.0 Object Library」ライブラリーを有効にして、上記のコードを有効にし、実行してみて下さい。自動実行まで実施できた方が居ましたら、連絡頂けると幸いです。
閉じるときに保存しない（確認画面を出さない）
Sub Auto_Close()
ThisWorkbooks.Close SaveChanges:=False
End Sub
作成したVBAを提供
上で解説した「設定画面作成」と「コード作成」を順にすべて作成したものをこちらをクリックしてダウンロードできます。
作成するのが面倒な方や、作成したけどうまく動作しない方はダウンロードしてご利用ください。
ダウンロードしたVBAファイルはセキュリティ設定を変更しないと起動できませんので、以下の手順でご利用ください。
ファイルを右クリックしてプロパティを選択します。
画面下のセキュリティの項目で「許可する」にチェックを入れて「OK」をクリックします。
VBAの自動実行について
ここまで準備ができれば、あとは作成したVBAを毎日1回スケジュール設定で実行するだけです。
VBAの自動実行については以前に作成したこちらの記事を参考に設定して下さい。
あとがき
今回利用した機能以外にもVBAでブラウザ操作してできる事は色々あります。別の機会があれば、機能別に整理して情報提供したいと思いますが、やはり基本は、やりたい事があって、それを実現するために調べながら覚えるのが一番だと思います。
とはいえ、どのような事ができるのかを知らなければ、そもそもＶＢＡで作成できる事に気が付けないので、浅く広い知識も必要となります。ニワトリが先か卵が先かの議論と似ていますが、どちらでも良いので、私と一緒に一歩ずつ先進しましょう。
