EXCEL超初心者マクロ(3)-ヤマト運輸 荷物お問い合わせ-

2018年6月21日EXCEL/ACCESS

ヤマト運輸 荷物お問い合わせ(宅急便番号調査追跡)作ってみた。

メインEXCEL:Sample_3.xlsm

クロネコヤマトの宅急便でおなじみのヤマト運輸の荷物お問い合わせをexcelで作ってみました。
数件程度でしたら調べるのはたいして手間ではないと思いますが、大量の番号を検索するのに使えますので、ご利用ください。
私の環境で100件2分ぐらいでした。
フリーソフトと言うと恥ずかしいですが、勉強にどうぞ。ただ、責任は取れませんのでよろしく。

【背景】
個人のかたは、1件ずつの宅急便伝票番号検索しますよね。会社で荷物を発送している場合、まとめて大量に検索したいことってありませんか?
B2クラウドとかで出荷していると、ある程度の追跡ができるのですが、ちょっと使いづらいです。自分も以前、メール便(今はDM便)1000通の配達状況を調べなければならない事があり、そのときにグぐって作成したのが始まりです。後にHPの構造が変わってしまい放置していたのを、再構築しています。

問い合わせ番号を網羅していないので検証は終わっていませんが、多分使えると思います。
※フリーソフトと言うと恥ずかしいですが、勉強にどうぞ。ただ、責任は取れませんのでよろしく

【注意】
・このEXCELは自由にご使用いただいて結構ですが、使用による損害等は一切受けませんのでご了承ください。※フリーでご使用ください。
・ヤマト運輸のホームページの構造が変わると修正が必要となります。
・パソコンの環境によって、動かない、遅い、エラーになる等あります。
・マクロの中に簡単な説明が書いてありますので、ご参考にください。

【内容】
EXCELの「yamato」シートの荷物番号をIEから1件ずつ検索して、番号(分割)・更新日(月日)・配達状況を貼り付けるというものです。
HTMLソースを読み込んで、内容をコントロールしています。

検索ページを問い合わせ番号でダイレクトにIEを起動。
各classの内容を取り出し、excelに貼り付け

DM便やネコポスでも検索できます。

 

 

以下、内容です。

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^^)"
'
'

EXCEL/ACCESS

Posted by master