駐車場予約サイトakippaをVBAで自動操作

スポンサーリンク

2017/12/18追記

akippaのサイトリニューアルに伴いVBAでの処理内容を変更が必要になりました。
こちらの記事の内容は使えなくなっています。
新しいサイトの操作はこちら(http://officevba.info/akippakyousouvba2/)をご覧ください。

駐車場予約サイトakippaの操作

近頃、登録されている駐車場を予約する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 (“http://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

このコードを使用すると自動で予約できますが、車両ナンバーがうまく入力されないようです。
また改良方法思いついたら記載します。

おすすめ書籍 amazonicon Amazon rakutenicon 楽天 Yahooicon Yahoo検索
amazoniconAmazon
rakutenicon楽天Kobo電子書籍ストア
Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013/2010/2007/2003対応【電子書籍】[ 近田 伸矢 ]
価格:1,781
rakutenicon楽天ブックス
Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013/2010/2007/2003 [ 近田伸矢 ]
価格:2,530
rakuteniconHMV&BOOKS online 1号店
【送料無料】 Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013 / 2010 / 2007 / 2003対応 / 近田伸矢 【本】
価格:2,530
rakuteniconbookfan 2号店 楽天市場店
Excel VBAでIEを思いのままに操作できるプログラミング術/近田伸矢/植木悠二/上田寛【1000円以上送料無料】
価格:2,530
rakuteniconぐるぐる王国DS 楽天市場店
Excel VBAでIEを思いのままに操作できるプログラミング術
価格:2,530
rakuteniconCD&DVD NEOWING
Excel VBAでIEを思いのままに操作できるプログラミング術[本/雑誌] (単行本・ムック) / 近田伸矢/著 植木悠二/著 上田寛/著
価格:2,530
rakuteniconぐるぐる王国 楽天市場店
Excel VBAでIEを思いのままに操作できるプログラミング術
価格:2,530
rakuteniconブックオフオンライン楽天市場店
【中古】 Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013/2010/2007/2003対応 /近田伸矢,植木悠二,上田寛【 【中古】afb
価格:1,980
rakuteniconbookfan 1号店 楽天市場店
Excel VBAでIEを思いのままに操作できるプログラミング術/近田伸矢/植木悠二/上田寛【合計3000円以上で送料無料】
価格:2,530
rakuteniconドラマ 本と中古ゲームの販売買取
Excel VBAでIEを思いのままに操作できるプログラミング術 近田伸矢/著 植木悠二/著 上田寛/著
価格:2,530
Yahooiconぱーそなるたのめーる
インプレス Excel VBAでIEを思いのままに操作できるプログラミング術 1冊 (メーカー直送)
価格:2,530
Yahooicon京都 大垣書店オンライン
Excel VBAでIEを思いのままに操作できるプログラミング術 / 近田 伸矢 他著
価格:2,530
YahooiconWINDY BOOKS on line
Excel  VBAでIEを思いのままに操作できるプログラミング術 / 出版社-インプレスジャパン
価格:2,530
YahooiconHonya Club.com PayPayモール店
Excel VBAでIEを思いのままに操作できるプログラミング術/近田伸矢
価格:2,530
Yahooiconbookfanプレミアム
Excel VBAでIEを思いのままに操作できるプログラミング術 / 近田伸矢 / 植木悠二 / 上田寛
価格:2,530
Yahooiconぐるぐる王国DS ヤフー店
Excel VBAでIEを思いのままに操作できるプログラミング術
価格:2,530
Yahooiconぐるぐる王国2号館 ヤフー店
Excel VBAでIEを思いのままに操作できるプログラミング術
価格:2,530
Yahooiconぐるぐる王国 スタークラブ
Excel VBAでIEを思いのままに操作できるプログラミング術
価格:2,530
Yahooiconぐるぐる王国 PayPayモール店
Excel VBAでIEを思いのままに操作できるプログラミング術
価格:2,530
Yahooiconbookfan PayPayモール店
Excel VBAでIEを思いのままに操作できるプログラミング術/近田伸矢/植木悠二/上田寛
価格:2,530
Yahooiconebookjapan
Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013/2010/2007/2003対応 電子書籍版
価格:1,780
YahooiconNEW SEEK
Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013/2010/2007/2003対応 中古 古本
価格:3,897
YahooiconBLANCOL
Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013/2010/2007/2003対応 中古書籍
価格:3,180
Yahooicon本とゲームのドラマYahoo!店
Excel VBAでIEを思いのままに操作できるプログラミング術 近田伸矢/著 植木悠二/著 上田寛/著
価格:2,530
Yahooiconドラマ書房Yahoo!店
Excel VBAでIEを思いのままに操作できるプログラミング術 近田伸矢/著 植木悠二/著 上田寛/著
価格:2,530
YahooiconHMV&BOOKS online Yahoo!店
Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013 / 2010 / 2007 / 2003対応 / 近田伸矢  〔本〕
価格:2,530
YahooiconBOOKOFF Online ヤフー店
Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013/2010/2007/2003対応/近田伸矢,植木悠二,上田寛【
価格:1,980
YahooiconネオウィングYahoo!店
【ゆうメール利用不可】Excel VBAでIEを思いのままに操作できるプログラミング術/近田伸矢/著 植木悠二/著 上田寛/著(単行本・ムック)
価格:2,530
YahooiconECJOY!ブックス ヤフー店
インプレスジャパン Excel VBAでIEを思いのままに操作できるプログラミング術 近田伸矢/著 植木悠二/著 上田寛/著
価格:2,530

コメント