駐車場予約サイトakippaの予約競争に勝つVBAコード2

スポンサーリンク

駐車場予約サイトakippaがリニューアルされました

登録されている駐車場を予約するakippaの自動予約のVBAコードを紹介しましたが、サイトのリニューアルに伴い使用できなくなりました。

今回は新しくなったサイトを操作するVBAコードを紹介します。

駐車場予約サイト「akippa」

作成したファイルのシートとVBAコード

シートの画像と説明

Excelのシートは下記のように以前使用していたものとほぼ同じ作りのままにしています。

81-2

シートには電話番号、車種、車両ナンバー、カート番号、有効期限月、有効期限年、カード名義名、カード名義姓、駐車場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

おすすめ書籍 amazonicon Amazon rakutenicon 楽天 Yahooicon Yahoo検索

コメント