郵便の追跡番号大量確認用ツールを作りました。
VBAとSeleniumとChromeを使って、さまざまな自動化をしている人事部のたかはしです。
…まあ人事部ってのは嘘ですが、プログラミングとは全く関係のない仕事してます。
自動化は業務時間内に余裕がある時にやってます。
と、いうわけで適当に作って完成した郵便の追跡番号大量確認のツールを皆様に発表したいと思います。
上限は1000としてますが、実質無制限です。
サイト側の制限がかかったら使えないかもしれません、ご注意ください。
参考画像
標準コードに貼り付ける内容
Sub SearchNumbers()
'起動シートの初期処理ここから----------------
Set Thisbk = ThisWorkbook
Dim ms As Worksheet
Set ms = Thisbk.Sheets("main")
Dim N As String
Dim c As Long
Dim cnt As Long
Dim cntm As Long
'ここまで------------------------------------
'入力されている追跡番号の数をカウント
c = Application.WorksheetFunction.CountA(Range("C3:C1048576"))
'結果出力範囲の中身を全てクリア
ms.Range("D3:G1048576").ClearContents
'追跡サイトの1度の検索数が10個の為、10で割ってページを開く回数を計算
cnt = c / 10
'10で割った余りの数を計算
cntm = c Mod 10
'Seleniumの初期処理--------------------------
Dim Driver As New Selenium.WebDriver
Driver.AddArgument "--incognito" 'シークレットモード
Driver.AddArgument "disable-gpu"
Driver.AddArgument "start-maximized"
'Driver.AddArgument "headless" 'バックグラウンド処理
'Seleniumの初期処理ここまで------------------
'Chrome起動----------------------------------
Call Driver.Start("chrome")
' エラーが発生しても無視して処理を継続させる
On Error Resume Next
'それぞれの番号を入力
'ページを繰り返す数
Dim i As Long
'追跡番号の繰り返し(最大10回)
Dim p As Long
'10で割った数プラス1回ページを開く必要がある-------
For i = 1 To cnt + 1
'郵便追跡番号確認サイトを開く
Driver.Get "https://trackings.post.japanpost.jp/services/srv/search/input"
'追跡番号入力の繰り返し----------------------
For p = 1 To 10
'追跡暗号を格納＆入力
N = ms.Cells((10 * i) - 8 + p, 3)
Driver.FindElementsByXPath("//*[@id=""content""]/form/div[1]/ul/li[*]/label/input")(p).SendKeys N
Next p
'追跡番号入力の繰り返しここまで--------------
'確認ボタンクリック
Driver.FindElementByXPath("//*[@id=""content""]/form/p[1]/input").Click
Driver.Wait 500
'確認結果の出力繰り返し----------------------
For p = 1 To 10
'最新年月日
ms.Cells((10 * i) - 8 + p, 4) = Driver.FindElementsByXPath("//*[@id=""content""]/form/div/table/tbody/tr[*]/td[3]")(p).Text
'最新状態
ms.Cells((10 * i) - 8 + p, 5) = Driver.FindElementsByXPath("//*[@id=""content""]/form/div/table/tbody/tr[*]/td[4]")(p).Text
'最新取扱局
ms.Cells((10 * i) - 8 + p, 6) = Driver.FindElementsByXPath("//*[@id=""content""]/form/div/table/tbody/tr[*]/td[5]")(p).Text
Next p
'確認結果の出力繰り返しここまで--------------
Next i
'10で割った数プラス1回ページを開く必要があるここまで-------
Driver.Close
MsgBox "完了"
End Sub
