EXCEL超初心者マクロ(3)-ヤマト運輸 荷物お問い合わせ-
ヤマト運輸 荷物お問い合わせ(宅急便番号調査追跡)作ってみた。
2022/4/5
ヤマトの問い合わせページが刷新されたため、マクロを修正しました。伝票番号が分からないのでほとんど動作確認はしてません。
また、IEがEdgeにかわるアナウンスが出ているので、短命かもしれません。
メインEXCEL:
Sample_3.xlsm
Sample_YAMATO20220405HP
SAGAWA、JP 版
クロネコヤマトの宅急便でおなじみのヤマト運輸の荷物お問い合わせをexcelで作ってみました。
数件程度でしたら調べるのはたいして手間ではないと思いますが、大量の番号を検索するのに使えますので、ご利用ください。
私の環境で100件2分ぐらいでした。
フリーソフトと言うと恥ずかしいですが、勉強にどうぞ。ただ、責任は取れませんのでよろしく。
作成OFFICE version office2016pro
※office2010だと動かない事象が出ています。
IEがメッセージ等で止まらないで立ち上がるようにしてください。
【背景】
個人のかたは、1件ずつの宅急便伝票番号検索しますよね。会社で荷物を発送している場合、まとめて大量に検索したいことってありませんか?
B2クラウドとかで出荷していると、ある程度の追跡ができるのですが、ちょっと使いづらいです。自分も以前、メール便(今はDM便)1000通の配達状況を調べなければならない事があり、そのときにグぐって作成したのが始まりです。後にHPの構造が変わってしまい放置していたのを、再構築しています。
問い合わせ番号を網羅していないので検証は終わっていませんが、多分使えると思います。
※フリーソフトと言うと恥ずかしいですが、勉強にどうぞ。ただ、責任は取れませんのでよろしく
【注意】
・このEXCELは自由にご使用いただいて結構ですが、使用による損害等は一切受けませんのでご了承ください。※フリーでご使用ください。
・ヤマト運輸のホームページの構造が変わると修正が必要となります。
・パソコンの環境によって、動かない、遅い、エラーになる等あります。
・マクロの中に簡単な説明が書いてありますので、ご参考にください。
【内容】
EXCELの「yamato」シートの荷物番号をIEから1件ずつ検索して、番号(分割)・更新日(月日)・配達状況を貼り付けるというものです。
HTMLソースを読み込んで、内容をコントロールしています。
検索ページを問い合わせ番号でダイレクトにIEを起動。
各classの内容を取り出し、excelに貼り付け
DM便やネコポスでも検索できます。
Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013/2010/2007/2003 [ 近田伸矢 ]
|
以下、内容です。
yamato
' ***処理確認*** MSG_FLG = MsgBox("シートDATAの準備おkですか?", vbYesNo) If MSG_FLG = vbNo Then Exit Sub End If '######## C:F クリア ######### Sheets("yamato").Select Columns("D:F").Select Selection.ClearContents Range("A1").Select Set set_data01 = Worksheets("yamato").Range("A2") set_data01.Offset(-1, 3).Value = "検索/伝票番号" set_data01.Offset(-1, 4).Value = "更新日" set_data01.Offset(-1, 5).Value = "配達状況" CNT02 = 0 Do Until set_data01.Offset(0, 0).Value = "" '######### 宣言 Set IEOPEN = CreateObject("InternetExplorer.Application") IEOPEN.Visible = True '######### ysmato問い合わせをダイレクトにIEでopen IEOPEN.navigate "https://jizen.kuronekoyamato.co.jp/jizen/servlet/crjz.b.NQ0010?id=" & set_data01.Offset(0, 1).Value '######### 1秒待つ ' waittime = Now + TimeValue("00:00:01") ' Application.Wait waittime '######### IEの起動を待つ CNT01 = 0 Do While IEOPEN.Busy = True Or IEOPEN.readyState <> 4 DoEvents Application.Wait (Now + TimeValue("00:00:01")) CNT01 = CNT01 + 1 If CNT01 >= 10 Then 'ページの再読み込み(リフレッシュ) IEOPEN.Refresh CNT01 = 0 End If Loop '######### 1秒待つ ' waittime = Now + TimeValue("00:00:01") ' Application.Wait waittime '######### 各データクラスを取込む ' Set OBJA = IEOPEN.document.getElementsByClassName("denpyo") ' Set OBJB = IEOPEN.document.getElementsByClassName("hiduke") ' Set OBJC = IEOPEN.document.getElementsByClassName("ct") '######### 各データクラスの一件目を取込む ※状態は3件目から 構造による wdenpyo = IEOPEN.document.getElementsByClassName("denpyo")(0).innerText whiduke = IEOPEN.document.getElementsByClassName("hiduke")(0).innerText wct = IEOPEN.document.getElementsByClassName("ct")(0 + 2).innerText '######### 取込んだデータをexcelに貼り付け ※分かりやすいように分けています。 set_data01.Offset(0, 3).Value = wdenpyo set_data01.Offset(0, 4).Value = whiduke set_data01.Offset(0, 5).Value = wct '######### ie close ※溜まらないように IEOPEN.Quit Set IEOPEN = Nothing CNT02 = CNT02 + 1 Application.StatusBar = "取込み開始 >" & CNT02 & " 件" '######### 念のため CNT02 = CNT02 + 1 If CNT02 > 500 Then MsgBox ("STOP 500ken あとで IEキャッシュクリアしてください") CNT02 = 1 End If '######### 次の行 Set set_data01 = set_data01.Offset(1, 0) Loop MsgBox ("終了") Application.StatusBar = "処理終了....(v^^)" ' '
ディスカッション
コメント一覧
まだ、コメントがありません