駐車場予約サイトakippaがリニューアルされました
登録されている駐車場を予約するakippaの自動予約のVBAコードを紹介しましたが、サイトのリニューアルに伴い使用できなくなりました。
今回は新しくなったサイトを操作するVBAコードを紹介します。
作成したファイルのシートとVBAコード
シートの画像と説明
Excelのシートは下記のように以前使用していたものとほぼ同じ作りのままにしています。
シートには電話番号、車種、車両ナンバー、カート番号、有効期限月、有効期限年、カード名義名、カード名義姓、駐車場URL、開始時間を登録できるようにしておき、時間が来たらInternetExplorerを起動して予約する仕組みにしています。
予約システムの変更で、メールアドレスが不要になったのでシートから項目を削除しました。
最初の1回は予約にカードの情報などが必要ですが、2回目以降実行する際はクレジットの情報などはブラウザで登録されているようです。
よって2回目以降はこちらのファイルに情報を入力しなくても大丈夫です。
ファイルにクレジットの番号を記載することに抵抗のある方は、この欄を最初から空欄にしておいて、最後の予約画面で手入力して確定させても大丈夫です。
シート上には予約実行ボタン・予約解除のボタンを用意しています。
予約実行ボタンの目的は2つあり、1つ目は起動する手間を省くことです。
もう1つの目的は待機中にきちんと起動しているかを確認するためです。
起動中予約実行ボタンが赤くなるようにして、目で見て実行中であることを確認できるようにしています。
（ボタンの名前は「予約」にしておいて、VBAで色を変更できるように設定しています。）
予約解除ボタンはエラーなどが生じた際にマクロを中断できるようにする目的で設置しています。
作成したVBAコード
作成したVBAコードは以下のようになります。
指定した時間の1分前に一度画面を更新して、時間が来たらもう一度画面を更新して予約を取得するプログラムになっています。
1分前に1度更新しているのは、長時間放置した際にネットの接続が悪かったのか、きちんとページが表示されないことがあったので、その防止のためです。
予約開始は少なくとも1分30秒くらい空けておかないと、更新の間に予約開始時間が過ぎてしまい、その後の予約実行につながらないので注意してください。
最初の起動の時はページが表示された段階で、手動でログインしてください。
今回のサイトリニューアルでタグがページの要素の中にきちんとIdやNameが割り振られるようになったので、操作しやすくなりました。
スピードも上がってスムーズになったと思います。
下記のコードを使用する際の注意点ですが、参照設定の「Microsoft HTML Object Library」と「Microsoft Internet Controls」にチェックしてからでないと使用できません。
詳細はこちら（https://officevba.info/iecontrolvbe/）のページをご確認ください
Option Explicit
Dim colSh As Object
Dim win As Object
Dim IE As Object
Dim objIE(5) As Object
Dim txtInput(16) As Object
Dim txtInput2(20) As Object
Dim pwin As Object
Dim Anchor As Object
Dim stopflag
Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)
Sub タイマー実行()
Dim 駐車場URL As String
駐車場URL = Cells(8, 3)
Dim 予約実行時間 As Date
予約実行時間 = Cells(1, 15)
Dim 予約実行前更新時間
Set IE = CreateObject(“InternetExplorer.application”)
IE.Visible = True
IE.navigate (“https://officevba.info/akippakyousouvba2/”)
Do While IE.Busy Or IE.readyState < 3
DoEvents
Sleep 1
Loop
Sleep 100
Dim IeFlag
IeFlag = False ’きちんと読み込めたときのフラグ
Do Until IeFlag = True
For Each Anchor In IE.document.getElementsByTagName(“A”)
If InStr(Anchor.innerText, “駐車場予約サイト「akippa」”) > 0 Then
Anchor.Click
IeFlag = True
Exit For
End If
Next
Loop
Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 5000
Set IE = Nothing
IeFlag = False ’きちんと読み込めたときのフラグ
Do Until IeFlag = True
Set colSh = CreateObject(“Shell.Application”)
For Each win In colSh.Windows
If TypeName(win.document) = “HTMLDocument” Then
If win.document.Url = “https://www.akippa.com/” Then
Set IE = win
IeFlag = True
Exit For
End If
End If
Next
Loop
IE.navigate (駐車場URL)
Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 1000
Set IE = Nothing
stopflag = False
表示実行中
予約実行前更新時間 = 予約実行時間 － 1 / 1440
If 予約実行前更新時間 < 0 Then ’時間が－になってしまった場合のエラー処理
予約実行前更新時間 = “23:59:00”
End If
Do Until stopflag = True
If Hour(Time) = Hour(予約実行前更新時間) And Minute(Time) = Minute(予約実行前更新時間) And Second(Time) >= Second(予約実行前更新時間) Then
Beep
IE更新
Exit Do
End If
Sleep 1
DoEvents
Loop
Do Until stopflag = True
If Hour(Time) = Hour(予約実行時間) And Minute(Time) = Minute(予約実行時間) And Second(Time) >= Second(予約実行時間) Then
Beep
IE更新と予約実行
stopflag = True
End If
Sleep 1
DoEvents
Loop
End Sub
Private Sub IE更新()
Set colSh = CreateObject(“Shell.Application”)
For Each win In colSh.Windows
If TypeName(win.document) = “HTMLDocument” Then
If win.document.Url = Cells(8, 3).Text Then
Set objIE(0) = win
Exit For
End If
End If
Next
objIE(0).Refresh
End Sub
Private Sub IE更新と予約実行()
Set colSh = CreateObject(“Shell.Application”)
For Each win In colSh.Windows
If TypeName(win.document) = “HTMLDocument” Then
If win.document.Url = Cells(8, 3).Text Then
Set objIE(1) = win
Exit For
End If
End If
Next
objIE(1).Refresh
Do While objIE(1).Busy Or objIE(1).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
予約実行
表示標準
End Sub
Private Sub 予約実行()
Dim 電話番号
Dim 車種
Dim 車両ナンバー
Dim 取得希望日
電話番号 = Replace(Cells(2, 3), “-“, “”)
車種 = Cells(3, 3)
車両ナンバー = Cells(4, 3)
取得希望日 = Cells(10, 3)
Dim カード番号
カード番号 = Cells(2, 5)
Set colSh = CreateObject(“Shell.Application”)
For Each win In colSh.Windows
If TypeName(win.document) = “HTMLDocument” Then
If win.document.Url = Cells(8, 3).Text Then
Set objIE(2) = win
Exit For
End If
End If
Next
’On Error GoTo 待機
Dim Doc As HTMLDocument
Set Doc = objIE(2).document
Dim i As Long
Dim x As Long
Dim y, m, d
’日付
y = Format(Year(取得希望日), “0000”)
m = Format(Month(取得希望日), “00”)
d = Format(Day(取得希望日), “00”)
Set txtInput(0) = objIE(2).document.getElementById(“check-” & y & “-” & m & “-” & d)
txtInput(0).Checked = True
’ナンバー
Set txtInput(1) = objIE(2).document.getElementsByName(“car_number”)(0)
txtInput(1).Value = 車両ナンバー
Sleep 100
’車種
Set txtInput2(2) = objIE(2).document.getElementById(“daily-car-type”)
txtInput2(2).Value = 車種
’電話番号
Set txtInput(3) = objIE(2).document.getElementsByName(“phone_number”)(0)
txtInput(3).Value = 電話番号
Sleep 100
’決済画面に
Set txtInput(4) = objIE(2).document.getElementById(“action-confirm-daily-reservation”)
txtInput(4).Click
Do While objIE(2).Busy Or objIE(2).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 3000
決済入力
End Sub
Private Sub 決済入力()
Dim 電話番号
Dim カード番号
Dim 有効期限月
Dim 有効期限年
Dim カード名義名
Dim カード名義姓
Dim カード名義
電話番号 = Cells(2, 3)
カード番号 = Replace(Cells(2, 5), “-“, “”)
有効期限月 = Format(Cells(3, 5), “00”)
有効期限年 = Right(Format(Cells(4, 5), “0000”), 2)
カード名義名 = Cells(5, 5)
カード名義姓 = Cells(6, 5)
カード名義 = カード名義名 & ” ” & カード名義姓
Set colSh = CreateObject(“Shell.Application”)
For Each win In colSh.Windows
If TypeName(win.document) = “HTMLDocument” Then
If InStr(win.document.Title, “akippa”) > 0 Then
Set objIE(3) = win
Exit For
End If
End If
Next
On Error Resume Next
If Cells(2, 5) <> “” Then
Set txtInput(5) = objIE(3).document.getElementById(“cardNo”)
txtInput(5).Value = カード番号
End If
If Cells(3, 5) <> “” Then
Set txtInput2(6) = objIE(3).document.getElementById(“cardMonth”)
txtInput2(6).Value = 有効期限月
End If
If Cells(4, 5) <> “” Then
Set txtInput2(7) = objIE(3).document.getElementById(“cardYear”)
txtInput2(7).Value = 有効期限年
End If
If Cells(5, 5) <> “” Or Cells(6, 5) <> “” Then
Set txtInput(8) = objIE(3).document.getElementById(“holderName”)
txtInput(8).Value = カード名義
End If
On Error GoTo 0
Set txtInput(10) = objIE(3).document.getElementById(“sizeCheck”)
txtInput(10).Checked = True
Set pwin = objIE(3).document.parentWindow
pwin.execScript “creditCardButtonCheck()”
Do While objIE(3).Busy Or objIE(3).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 2000
Set txtInput(11) = objIE(3).document.getElementById(“creditButton”)
txtInput(11).Click
End Sub
Private Sub 表示実行中()
Dim shp
For Each shp In ActiveSheet.Shapes
If shp.Name = “予約” Then
shp.Fill.ForeColor.RGB = RGB(255, 0, 0)
End If
Next
End Sub
Private Sub 表示標準()
Dim shp
For Each shp In ActiveSheet.Shapes
If shp.Name = “予約” Then
shp.Fill.ForeColor.RGB = RGB(242, 220, 219)
End If
Next
End Sub
Sub 予約中断()
stopflag = True
表示標準
End Sub
Dim colSh As Object
Dim win As Object
Dim IE As Object
Dim objIE(5) As Object
Dim txtInput(16) As Object
Dim txtInput2(20) As Object
Dim pwin As Object
Dim Anchor As Object
Dim stopflag
Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)
Sub タイマー実行()
Dim 駐車場URL As String
駐車場URL = Cells(8, 3)
Dim 予約実行時間 As Date
予約実行時間 = Cells(1, 15)
Dim 予約実行前更新時間
Set IE = CreateObject(“InternetExplorer.application”)
IE.Visible = True
IE.navigate (“https://officevba.info/akippakyousouvba2/”)
Do While IE.Busy Or IE.readyState < 3
DoEvents
Sleep 1
Loop
Sleep 100
Dim IeFlag
IeFlag = False ’きちんと読み込めたときのフラグ
Do Until IeFlag = True
For Each Anchor In IE.document.getElementsByTagName(“A”)
If InStr(Anchor.innerText, “駐車場予約サイト「akippa」”) > 0 Then
Anchor.Click
IeFlag = True
Exit For
End If
Next
Loop
Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 5000
Set IE = Nothing
IeFlag = False ’きちんと読み込めたときのフラグ
Do Until IeFlag = True
Set colSh = CreateObject(“Shell.Application”)
For Each win In colSh.Windows
If TypeName(win.document) = “HTMLDocument” Then
If win.document.Url = “https://www.akippa.com/” Then
Set IE = win
IeFlag = True
Exit For
End If
End If
Next
Loop
IE.navigate (駐車場URL)
Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 1000
Set IE = Nothing
stopflag = False
表示実行中
予約実行前更新時間 = 予約実行時間 － 1 / 1440
If 予約実行前更新時間 < 0 Then ’時間が－になってしまった場合のエラー処理
予約実行前更新時間 = “23:59:00”
End If
Do Until stopflag = True
If Hour(Time) = Hour(予約実行前更新時間) And Minute(Time) = Minute(予約実行前更新時間) And Second(Time) >= Second(予約実行前更新時間) Then
Beep
IE更新
Exit Do
End If
Sleep 1
DoEvents
Loop
Do Until stopflag = True
If Hour(Time) = Hour(予約実行時間) And Minute(Time) = Minute(予約実行時間) And Second(Time) >= Second(予約実行時間) Then
Beep
IE更新と予約実行
stopflag = True
End If
Sleep 1
DoEvents
Loop
End Sub
Private Sub IE更新()
Set colSh = CreateObject(“Shell.Application”)
For Each win In colSh.Windows
If TypeName(win.document) = “HTMLDocument” Then
If win.document.Url = Cells(8, 3).Text Then
Set objIE(0) = win
Exit For
End If
End If
Next
objIE(0).Refresh
End Sub
Private Sub IE更新と予約実行()
Set colSh = CreateObject(“Shell.Application”)
For Each win In colSh.Windows
If TypeName(win.document) = “HTMLDocument” Then
If win.document.Url = Cells(8, 3).Text Then
Set objIE(1) = win
Exit For
End If
End If
Next
objIE(1).Refresh
Do While objIE(1).Busy Or objIE(1).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
予約実行
表示標準
End Sub
Private Sub 予約実行()
Dim 電話番号
Dim 車種
Dim 車両ナンバー
Dim 取得希望日
電話番号 = Replace(Cells(2, 3), “-“, “”)
車種 = Cells(3, 3)
車両ナンバー = Cells(4, 3)
取得希望日 = Cells(10, 3)
Dim カード番号
カード番号 = Cells(2, 5)
Set colSh = CreateObject(“Shell.Application”)
For Each win In colSh.Windows
If TypeName(win.document) = “HTMLDocument” Then
If win.document.Url = Cells(8, 3).Text Then
Set objIE(2) = win
Exit For
End If
End If
Next
’On Error GoTo 待機
Dim Doc As HTMLDocument
Set Doc = objIE(2).document
Dim i As Long
Dim x As Long
Dim y, m, d
’日付
y = Format(Year(取得希望日), “0000”)
m = Format(Month(取得希望日), “00”)
d = Format(Day(取得希望日), “00”)
Set txtInput(0) = objIE(2).document.getElementById(“check-” & y & “-” & m & “-” & d)
txtInput(0).Checked = True
’ナンバー
Set txtInput(1) = objIE(2).document.getElementsByName(“car_number”)(0)
txtInput(1).Value = 車両ナンバー
Sleep 100
’車種
Set txtInput2(2) = objIE(2).document.getElementById(“daily-car-type”)
txtInput2(2).Value = 車種
’電話番号
Set txtInput(3) = objIE(2).document.getElementsByName(“phone_number”)(0)
txtInput(3).Value = 電話番号
Sleep 100
’決済画面に
Set txtInput(4) = objIE(2).document.getElementById(“action-confirm-daily-reservation”)
txtInput(4).Click
Do While objIE(2).Busy Or objIE(2).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 3000
決済入力
End Sub
Private Sub 決済入力()
Dim 電話番号
Dim カード番号
Dim 有効期限月
Dim 有効期限年
Dim カード名義名
Dim カード名義姓
Dim カード名義
電話番号 = Cells(2, 3)
カード番号 = Replace(Cells(2, 5), “-“, “”)
有効期限月 = Format(Cells(3, 5), “00”)
有効期限年 = Right(Format(Cells(4, 5), “0000”), 2)
カード名義名 = Cells(5, 5)
カード名義姓 = Cells(6, 5)
カード名義 = カード名義名 & ” ” & カード名義姓
Set colSh = CreateObject(“Shell.Application”)
For Each win In colSh.Windows
If TypeName(win.document) = “HTMLDocument” Then
If InStr(win.document.Title, “akippa”) > 0 Then
Set objIE(3) = win
Exit For
End If
End If
Next
On Error Resume Next
If Cells(2, 5) <> “” Then
Set txtInput(5) = objIE(3).document.getElementById(“cardNo”)
txtInput(5).Value = カード番号
End If
If Cells(3, 5) <> “” Then
Set txtInput2(6) = objIE(3).document.getElementById(“cardMonth”)
txtInput2(6).Value = 有効期限月
End If
If Cells(4, 5) <> “” Then
Set txtInput2(7) = objIE(3).document.getElementById(“cardYear”)
txtInput2(7).Value = 有効期限年
End If
If Cells(5, 5) <> “” Or Cells(6, 5) <> “” Then
Set txtInput(8) = objIE(3).document.getElementById(“holderName”)
txtInput(8).Value = カード名義
End If
On Error GoTo 0
Set txtInput(10) = objIE(3).document.getElementById(“sizeCheck”)
txtInput(10).Checked = True
Set pwin = objIE(3).document.parentWindow
pwin.execScript “creditCardButtonCheck()”
Do While objIE(3).Busy Or objIE(3).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 2000
Set txtInput(11) = objIE(3).document.getElementById(“creditButton”)
txtInput(11).Click
End Sub
Private Sub 表示実行中()
Dim shp
For Each shp In ActiveSheet.Shapes
If shp.Name = “予約” Then
shp.Fill.ForeColor.RGB = RGB(255, 0, 0)
End If
Next
End Sub
Private Sub 表示標準()
Dim shp
For Each shp In ActiveSheet.Shapes
If shp.Name = “予約” Then
shp.Fill.ForeColor.RGB = RGB(242, 220, 219)
End If
Next
End Sub
Sub 予約中断()
stopflag = True
表示標準
End Sub
おすすめ書籍 (広告)
Amazon 
楽天 
Yahoo検索
コメント
akippaの予約で使ってみたいのですがパソコンには弱くてよくわかりません
コードはコピペでいいんでしょうか？
シートは別で作らないといけないということですか？
ずぶの素人なので教えていただけるとありがたいです
ご連絡ありがとうございます。
こちらのコードはInternetExplorerを使用するかなり古いコードになっていて、
今はMicrosoftのサポートも終了しています。
また、akippa自体のサイトも数年前に操作したときに使ったものになり、
現在は使用できない可能性があります。
一応、ファイルを作って、画像の通りに必要項目を入力して
コピペしたコードを実行すれば動く可能性はありますが、
かなり難しい気がします。
お役に立てなくて申し訳ありません。
返信ありがとうございます
現在は使えないと言うことで残念です
恐らくこういったプログラムを組んで予約しているんだろうと思うのですが9時の時報と共に予約が取られてしまって絶対に取れない駐車場があるんです
悔しくて一回くらい取ってやろうと思ったのですが
パソコンに疎いのでこういった事が出来る人羨ましいですwww