2017/12/18追記
akippaのサイトリニューアルに伴いVBAでの処理内容を変更が必要になりました。
こちらの記事の内容は使えなくなっています。
新しいサイトの操作はこちら（https://officevba.info/akippakyousouvba2/）をご覧ください。
駐車場予約サイトakippaの操作
近頃、登録されている駐車場を予約するakippaという以下のサイトが話題になっています。
コインパーキングと異なり事前にネットで予約できるので、いざというときに埋まっていて駐車できないなどの状況にならないのが特徴です。また駐車場は空きスペースのある方の登録で増えているようで、登録されている中には普通の民家の駐車場などもあります。
今回はこの駐車場予約サイトakippaで自動予約できるVBAコードを紹介します。
スポンサーリンク
akippaを自動操作して1日単位の予約を自動で行うVBAコード
今回、知人から1日単位で駐車場を予約する作業を自動化できないか？との相談がありました。
どうやら、先々の日付で予約したい場合、特に1日単位で予約が必要な場合、
①ページを開いて、
②「1日単位で予約」をクリック、
③「さらに先の日付を予約」をクリックしてから、
④目的の日付を選択し、
⑤費用を支払いする
という手順になります。
何日も継続して予約をするには少し手間がかかる気もします。
今回はこの①～⑤のステップを自動化するVBAコードを作成しました。
下図のようにC10のセルから下に連続で記入しておけば、その日付の内容を自動で予約してくれる仕組みになっています。
またどこの駐車場を予約するかについてもC8セルの中にURLを記載するようにしています。（ハイパーリンクはあってもなくても問題ありません。）
クレジットカードの番号などは一度使用すると2回目以降はなくてもAkippa自体が予約できる仕組みになっています。
クレジットの情報や電話番号、メールアドレスなどはセルで指定していても大丈夫ですし、コードの中に記載しても大丈夫なように設定しています。
（今回の画像では番号やその他の情報は0やaの文字で置き換えています。実際の使用時はご自身の情報を使用してください。）
Option Explicit
Dim colSh As Object
Dim win As Object
Dim strTemp As String
Dim anchor As Object
Dim IE As Object
Dim objIE(5) As Object
Dim txtInput(16) As Object
Dim txtInput2(20) As Object
Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)
Sub 自動でAkippa予約()
’日付を記載した分の予約を実行します
リンククリックと起動
入力
End Sub
Private Sub リンククリックと起動()
’このブログを経由します
Set IE = CreateObject(“InternetExplorer.application”)
IE.Visible = True
Sleep 3000
IE.navigate (“https://officevba.info/akippavbanormal/”)
Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 100
For Each anchor In IE.document.getElementsByTagName(“A”)
If InStr(anchor.innerText, “駐車場予約サイト「akippa」”) > 0 Then
anchor.Click
Exit For
End If
Next
Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 5000
Set IE = Nothing
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 IE = win
Exit For
End If
End If
Next
IE.navigate (Cells(8, 3))
Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 1000
End Sub
Private Sub 入力()
Dim 車両ナンバー
Dim 車種 As String
Dim 電話番号 As String
Dim メールアドレス As String
車両ナンバー = Cells(2, 3).Value
車種 = Cells(3, 3).Value
電話番号 = Cells(4, 3).Value
メールアドレス = Cells(5, 3).Value
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(0) = win
Exit For
End If
End If
Next
On Error Resume Next
Set txtInput(0) = objIE(0).document.getElementById(“car_number”)
txtInput(0).Value = 車両ナンバー
On Error GoTo 0
Dim Doc As HTMLDocument
Set Doc = objIE(0).document
Dim i As Long
Dim x As Long
x = 10
Do Until Cells(x, 3) = “”
For i = 500 To 2000 ’大体この範囲を対象にしていれば問題なく実行できる
Cells(x, 3).NumberFormatLocal = “m/d(aaa)”
If Replace(Doc.all(i).innerText, ” “, “”) = Replace(Replace(Cells(x, 3).Text, “(“, “（”), “)”, “）”) And Doc.all(i).className = “m0 available_info_date” Then
Doc.all(i).Click
If Replace(Doc.all(i + 5).innerText, ” “, “”) = “満” Then
Cells(x, 4) = “×”
ElseIf Replace(Doc.all(i + 8).innerText, ” “, “”) = “空” Then
Cells(x, 4) = “○”
End If
Exit For
End If
Next i
x = x + 1
Loop
Set txtInput2(0) = objIE(0).document.getElementsByName(“car_type”)(0)
txtInput2(0).Value = 車種
Sleep 100
Do While objIE(0).Busy Or objIE(0).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Set txtInput(4) = objIE(0).document.getElementsByName(“phone_number”)(0)
txtInput(4).Value = Replace(電話番号, “-“, “”)
Sleep 100
Do While objIE(0).Busy Or objIE(0).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
On Error Resume Next
Set txtInput(5) = objIE(0).document.getElementById(“email”)
txtInput(5).Value = メールアドレス
Sleep 100
Do While objIE(0).Busy Or objIE(0).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
On Error GoTo 0
On Error Resume Next
Set txtInput(6) = objIE(0).document.getElementById(“car_number”)
txtInput(6).Value = 車両ナンバー
Sleep 100
Do While objIE(0).Busy Or objIE(0).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
On Error GoTo 0
Set txtInput(7) = objIE(0).document.getElementById(“dailyPayment”)
txtInput(7).Click
Sleep 2000
Do While objIE(0).Busy Or objIE(0).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Set txtInput(8) = objIE(0).document.getElementsByClassName(“daily_pay_credit_btn daily_submit_btn buttonA”)(0)
txtInput(8).Click
Sleep 1000
Do While objIE(0).Busy Or objIE(0).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 1000
決済入力
End Sub
Private Sub 決済入力()
Dim 電話番号 As String
Dim メールアドレス As String
Dim カード番号 As String
Dim カード有効期限月 As String
Dim カード有効期限年 As String
Dim カード名義名 As String
Dim カード名義姓 As String
電話番号 = Cells(4, 3).Value
メールアドレス = Cells(5, 3).Value
カード番号 = Cells(2, 5).Value
カード有効期限月 = Cells(3, 5).Value
カード有効期限年 = Cells(4, 5).Value
カード名義名 = Cells(5, 5).Value
カード名義姓 = Cells(6, 5).Value
Set colSh = CreateObject(“Shell.Application”)
For Each win In colSh.Windows
If TypeName(win.document) = “HTMLDocument” Then
If InStr(win.document.Title, “決済”) > 0 Then
Set objIE(1) = win
Exit For
End If
End If
Next
On Error Resume Next
Set txtInput(10) = objIE(1).document.getElementById(“cardno”)
txtInput(10).Value = Replace(カード番号, “-“, “”)
Set txtInput2(1) = objIE(1).document.getElementById(“expdate_m”)
txtInput2(1).Value = Format(カード有効期限月, “00”)
Set txtInput2(2) = objIE(1).document.getElementById(“expdate_y”)
txtInput2(2).Value = Format(カード有効期限年, “0000”)
Set txtInput(11) = objIE(1).document.getElementById(“firstname”)
txtInput(11).Value = カード名義名
Set txtInput(12) = objIE(1).document.getElementById(“lastname”)
txtInput(12).Value = カード名義姓
Set txtInput(13) = objIE(1).document.getElementById(“tel”)
txtInput(13).Value = Replace(電話番号, “-“, “”)
Set txtInput(14) = objIE(1).document.getElementById(“email”)
txtInput(14).Value = メールアドレス
Set txtInput(15) = objIE(1).document.getElementById(“Button1”)
txtInput(15).Click
Sleep 100
Do While objIE(1).Busy Or objIE(1).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 1000
Set txtInput(16) = objIE(1).document.getElementById(“Button1”)
txtInput(16).Click
On Error GoTo 0
End Sub
Dim colSh As Object
Dim win As Object
Dim strTemp As String
Dim anchor As Object
Dim IE As Object
Dim objIE(5) As Object
Dim txtInput(16) As Object
Dim txtInput2(20) As Object
Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)
Sub 自動でAkippa予約()
’日付を記載した分の予約を実行します
リンククリックと起動
入力
End Sub
Private Sub リンククリックと起動()
’このブログを経由します
Set IE = CreateObject(“InternetExplorer.application”)
IE.Visible = True
Sleep 3000
IE.navigate (“https://officevba.info/akippavbanormal/”)
Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 100
For Each anchor In IE.document.getElementsByTagName(“A”)
If InStr(anchor.innerText, “駐車場予約サイト「akippa」”) > 0 Then
anchor.Click
Exit For
End If
Next
Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 5000
Set IE = Nothing
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 IE = win
Exit For
End If
End If
Next
IE.navigate (Cells(8, 3))
Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 1000
End Sub
Private Sub 入力()
Dim 車両ナンバー
Dim 車種 As String
Dim 電話番号 As String
Dim メールアドレス As String
車両ナンバー = Cells(2, 3).Value
車種 = Cells(3, 3).Value
電話番号 = Cells(4, 3).Value
メールアドレス = Cells(5, 3).Value
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(0) = win
Exit For
End If
End If
Next
On Error Resume Next
Set txtInput(0) = objIE(0).document.getElementById(“car_number”)
txtInput(0).Value = 車両ナンバー
On Error GoTo 0
Dim Doc As HTMLDocument
Set Doc = objIE(0).document
Dim i As Long
Dim x As Long
x = 10
Do Until Cells(x, 3) = “”
For i = 500 To 2000 ’大体この範囲を対象にしていれば問題なく実行できる
Cells(x, 3).NumberFormatLocal = “m/d(aaa)”
If Replace(Doc.all(i).innerText, ” “, “”) = Replace(Replace(Cells(x, 3).Text, “(“, “（”), “)”, “）”) And Doc.all(i).className = “m0 available_info_date” Then
Doc.all(i).Click
If Replace(Doc.all(i + 5).innerText, ” “, “”) = “満” Then
Cells(x, 4) = “×”
ElseIf Replace(Doc.all(i + 8).innerText, ” “, “”) = “空” Then
Cells(x, 4) = “○”
End If
Exit For
End If
Next i
x = x + 1
Loop
Set txtInput2(0) = objIE(0).document.getElementsByName(“car_type”)(0)
txtInput2(0).Value = 車種
Sleep 100
Do While objIE(0).Busy Or objIE(0).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Set txtInput(4) = objIE(0).document.getElementsByName(“phone_number”)(0)
txtInput(4).Value = Replace(電話番号, “-“, “”)
Sleep 100
Do While objIE(0).Busy Or objIE(0).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
On Error Resume Next
Set txtInput(5) = objIE(0).document.getElementById(“email”)
txtInput(5).Value = メールアドレス
Sleep 100
Do While objIE(0).Busy Or objIE(0).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
On Error GoTo 0
On Error Resume Next
Set txtInput(6) = objIE(0).document.getElementById(“car_number”)
txtInput(6).Value = 車両ナンバー
Sleep 100
Do While objIE(0).Busy Or objIE(0).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
On Error GoTo 0
Set txtInput(7) = objIE(0).document.getElementById(“dailyPayment”)
txtInput(7).Click
Sleep 2000
Do While objIE(0).Busy Or objIE(0).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Set txtInput(8) = objIE(0).document.getElementsByClassName(“daily_pay_credit_btn daily_submit_btn buttonA”)(0)
txtInput(8).Click
Sleep 1000
Do While objIE(0).Busy Or objIE(0).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 1000
決済入力
End Sub
Private Sub 決済入力()
Dim 電話番号 As String
Dim メールアドレス As String
Dim カード番号 As String
Dim カード有効期限月 As String
Dim カード有効期限年 As String
Dim カード名義名 As String
Dim カード名義姓 As String
電話番号 = Cells(4, 3).Value
メールアドレス = Cells(5, 3).Value
カード番号 = Cells(2, 5).Value
カード有効期限月 = Cells(3, 5).Value
カード有効期限年 = Cells(4, 5).Value
カード名義名 = Cells(5, 5).Value
カード名義姓 = Cells(6, 5).Value
Set colSh = CreateObject(“Shell.Application”)
For Each win In colSh.Windows
If TypeName(win.document) = “HTMLDocument” Then
If InStr(win.document.Title, “決済”) > 0 Then
Set objIE(1) = win
Exit For
End If
End If
Next
On Error Resume Next
Set txtInput(10) = objIE(1).document.getElementById(“cardno”)
txtInput(10).Value = Replace(カード番号, “-“, “”)
Set txtInput2(1) = objIE(1).document.getElementById(“expdate_m”)
txtInput2(1).Value = Format(カード有効期限月, “00”)
Set txtInput2(2) = objIE(1).document.getElementById(“expdate_y”)
txtInput2(2).Value = Format(カード有効期限年, “0000”)
Set txtInput(11) = objIE(1).document.getElementById(“firstname”)
txtInput(11).Value = カード名義名
Set txtInput(12) = objIE(1).document.getElementById(“lastname”)
txtInput(12).Value = カード名義姓
Set txtInput(13) = objIE(1).document.getElementById(“tel”)
txtInput(13).Value = Replace(電話番号, “-“, “”)
Set txtInput(14) = objIE(1).document.getElementById(“email”)
txtInput(14).Value = メールアドレス
Set txtInput(15) = objIE(1).document.getElementById(“Button1”)
txtInput(15).Click
Sleep 100
Do While objIE(1).Busy Or objIE(1).readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 1000
Set txtInput(16) = objIE(1).document.getElementById(“Button1”)
txtInput(16).Click
On Error GoTo 0
End Sub
このコードを使用すると自動で予約できますが、車両ナンバーがうまく入力されないようです。
また改良方法思いついたら記載します。
おすすめ書籍 (広告)
Amazon 
楽天 
Yahoo検索
コメント