【保存版】2013年度発売全パチスロアプリ一覧(iPhone,iPad)

【Access】VBAでクロネコヤマトの荷物追跡サイトを自動チェックするサンプル。

ヤマト運輸配送状況問い合わせ

12桁の送り状番号があれば、クロネコヤマトのWEBサイトから配送状況を
取得することが可能です。
クロネコヤマトの荷物お問い合わせシステム

ただ、手入力はめんどくさいし、定期的にチェックさせたいというケースも
あるかと思います。

そこで今回は、AccessVBAからクロネコヤマトのWEBサイトを参照し、
配送状況を取得するサンプルをご紹介します。

VBAでクロネコヤマトのサイトから配送状況を取得する


まず、おさえておくこと。
・一度に10件の伝票を問い合わせすることが可能。
・数値以外は切り捨てられる仕様となっているようです。

あまりクロネコヤマトのサーバーに負荷をかけてもいけないので、
連続リクエストは1秒程度ウエイトを入れてあげればよいかと思います。
配送完了になったものについては、リクエストする必要はなくなるので、
あまり負荷のかかるような使い方はしなくてもよいケースが大半かとは思います。

取得の流れは、以下のような感じ。
・送り状番号をパラメータとし、http://toi.kuronekoyamato.co.jp/cgi-bin/tnekoへPOSTリクエストする。
・戻ってきたレスポンスを解析し、配送状況を取得する。

パラメータは、
number00= ・・・詳細表示あり、なし
number01〜number10 ・・・送り状番号
となります。

クロネコヤマト配送状況取得VBAサンプル


以下のソースをモジュールに貼り付けてください。
イミディエイトウインドから実行すると、配送状況取得結果が表示されます。
動作確認環境:WinXp-Access2003 Win7-Access2010


Option Compare Database
Option Explicit

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'SLEEP関数
Declare Function GetTickCount Lib "kernel32" () As Long

Public Function getYamatoShipStatus(InOkuriNoList As Variant)
'ヤマト配送状況取得

Dim httpObj As Object
Dim requestURI As String
Dim okuriNoList() As Variant
Dim okuriNoCnt As Long
Dim okuriNoMaxCnt As Long
Dim mParam As String
Dim bPmary() As Byte
Dim strResponse As String
Dim strMeisai As String

Dim lngCurPosi As Long
Dim lngEndPosi As Long
Dim lngTmpPosi As Long
Dim strTGT As String
Dim i As Integer
Dim x As Integer

Dim lngSTTIME As Long
Dim lngENDTIME As Long

On Error GoTo Err_Syori

getYamatoShipStatus = False

'送り状番号をセット
okuriNoList = InOkuriNoList

'問い合わせ処理開始
okuriNoMaxCnt = UBound(okuriNoList) + 1
okuriNoCnt = 0
Do Until (okuriNoCnt + 1) > okuriNoMaxCnt

'パラメーターセット
requestURI = "http://toi.kuronekoyamato.co.jp/cgi-bin/tneko"
mParam = "number00=1" 'number00 1:詳細あり 2:詳細なし
'10件までまとめて問い合わせを行う。
For i = 1 To 10
If okuriNoCnt < okuriNoMaxCnt Then
mParam = mParam & "&number" & Right("00" & CStr(i), 2) & "=" & okuriNoList(okuriNoCnt)
okuriNoCnt = okuriNoCnt + 1
Else
okuriNoCnt = okuriNoCnt + 1
Exit For
End If

Next i
bPmary = StrConv(mParam, vbFromUnicode)

'WAIT
lngENDTIME = GetTickCount()
If lngSTTIME <> 0 Then
'WAIT
If (lngENDTIME - lngSTTIME) < 1000 Then
'1秒に満たない場合、待機
Sleep 1000 - (lngENDTIME - lngSTTIME)
Debug.Print 1000 - (lngENDTIME - lngSTTIME) & "ミリ秒待機"
End If
End If
lngSTTIME = GetTickCount()

'WEB問い合わせ実行
Set httpObj = CreateObject("MSXML2.XMLHTTP")
httpObj.Open "POST", requestURI, False
httpObj.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
httpObj.Send (bPmary)

'レスポンスチェック
If httpObj.Status = "200" Then
strResponse = httpObj.ResponseText
Set httpObj = Nothing
Else
'エラー
Set httpObj = Nothing
MsgBox "レスポンスコード" & httpObj.Status, 16, "WEBレスポンス取得時エラー"
GoTo Err_Syori
End If

'変数初期化
lngCurPosi = 1
i = 0

Do
'配送詳細を伝票単位で取得
strTGT = "table class=""saisin"""
lngCurPosi = InStr(lngCurPosi, strResponse, strTGT)

If lngCurPosi > 0 Then
lngEndPosi = InStr(lngCurPosi + 1, strResponse, strTGT)

If lngEndPosi > 0 Then
strMeisai = Mid(strResponse, lngCurPosi, lngEndPosi - lngCurPosi + 1)
Else
strMeisai = Mid(strResponse, lngCurPosi)
End If

i = i + 1
Else
'処理を抜ける
Exit Do
End If

'取得配送データを解析
lngTmpPosi = 1

Debug.Print vbCrLf & i & "件目----------------------------------------"

'【伝票番号取得】
'伝票番号(開始位置)
strTGT = "伝票番号 "
lngTmpPosi = InStr(lngTmpPosi, strMeisai, strTGT)
lngTmpPosi = lngTmpPosi + Len(strTGT)
'伝票番号(終了位置)
strTGT = "<"
lngEndPosi = InStr(lngTmpPosi, strMeisai, strTGT)
If Nz(lngEndPosi, 0) > 0 Then
Debug.Print Mid(strMeisai, lngTmpPosi, lngEndPosi - lngTmpPosi)
End If

'配送状況(開始位置)
strTGT = ""
lngTmpPosi = InStr(lngTmpPosi, strMeisai, strTGT)
lngTmpPosi = lngTmpPosi + Len(strTGT)
'配送状況(終了位置)
strTGT = "<"
lngEndPosi = InStr(lngTmpPosi, strMeisai, strTGT)
If Nz(lngEndPosi, 0) > 0 Then
Debug.Print Mid(strMeisai, lngTmpPosi, lngEndPosi - lngTmpPosi)
End If

'【明細取得】
x = 1
Do

Dim strMSG As String
strMSG = "明細" & x & ":"

'イメージ画像位置
strTGT = ""
lngTmpPosi = InStr(lngTmpPosi, strMeisai, strTGT)

'明細終了チェック
If lngTmpPosi = 0 Then
Exit Do
Else
lngTmpPosi = lngTmpPosi + Len(strTGT)
End If

'配送状況(開始位置)
strTGT = ""
lngTmpPosi = InStr(lngTmpPosi, strMeisai, strTGT)
lngTmpPosi = lngTmpPosi + Len(strTGT)
'配送状況(終了位置)
strTGT = "<"
lngEndPosi = InStr(lngTmpPosi, strMeisai, strTGT)
If Nz(lngEndPosi, 0) > 0 Then
'lngEndPosi = lngEndPosi - 1
strMSG = strMSG & Mid(strMeisai, lngTmpPosi, lngEndPosi - lngTmpPosi) & Space(1)
Dim strHAISO_JYOKYO_DTL As String
strHAISO_JYOKYO_DTL = Mid(strMeisai, lngTmpPosi, lngEndPosi - lngTmpPosi)
End If

'日付(開始位置)
strTGT = ""
lngTmpPosi = InStr(lngTmpPosi, strMeisai, strTGT)
lngTmpPosi = lngTmpPosi + Len(strTGT)
'日付(終了位置)
strTGT = "<"
lngEndPosi = InStr(lngTmpPosi, strMeisai, strTGT)
If Nz(lngEndPosi, 0) > 0 Then
'lngEndPosi = lngEndPosi - 1
strMSG = strMSG & Mid(strMeisai, lngTmpPosi, lngEndPosi - lngTmpPosi) & Space(1)
End If

'時刻(開始位置)
strTGT = ""
lngTmpPosi = InStr(lngTmpPosi, strMeisai, strTGT)
lngTmpPosi = lngTmpPosi + Len(strTGT)
'時刻(終了位置)
strTGT = "<"
lngEndPosi = InStr(lngTmpPosi, strMeisai, strTGT)
If Nz(lngEndPosi, 0) > 0 Then
'lngEndPosi = lngEndPosi - 1
strMSG = strMSG & Mid(strMeisai, lngTmpPosi, lngEndPosi - lngTmpPosi) & Space(1)
End If

'明細出力
Debug.Print strMSG

x = x + 1
Loop


Next_Rec:
lngCurPosi = lngCurPosi + 1
Loop Until (i >= 10)

Loop

'処理結果
If i > 0 Then
Debug.Print vbCrLf & "(正常終了しました。)"
Else
Debug.Print vbCrLf & "(正常終了しましたが、問い合わせ結果はありません。)"
End If

getYamatoShipStatus = True

Exit Function

Err_Syori:
If Err.Number <> 0 Then
MsgBox Err.Number & Err.Description, 16, "システムエラー"
End If
End Function


サンプル確認方法


イミディエイトウインドから、
getYamatoShipStatus関数を呼び出します。引数は配列で渡します。
?getYamatoShipStatus(Array("伝票番号"))

VBAヤマト問い合わせサンプル実行結果

サンプルなので細かい部分は全くつめていませんが、とりあえずヤマトの
サイトから配送状況を取得するイメージをつかんでいただけるのでは
ないでしょうか?

それでは、また。

(関連エントリ)
伝票番号のチェックに関しては、こちらのエントリが参考になるかもしれません。
【Access】VBAで宅急便送り状番号の妥当性チェックを実装してみる。

1ライセンスで2台までインストール可能。12362円。安っ!
>>Microsoft Office Access 2013 [オンラインコード] [ダウンロード] (PC2台/1ライセンス)


こちらは全部入りのProfessional。
>>Microsoft Office Professional 2013 [オンラインコード] [ダウンロード] (PC2台/1ライセンス)


税理士さんが指導先の会社のために作成したノウハウをつめこみ。
Accessを本気で勉強したいが、まわりに教わる人がいない人に
おすすめ。(初心者の肩にはある程度難しいようです。)
>>経理業務のためのAccess実践講座―2007/2010/2013対応

[Google PR]

Twitterはじめました。プラプラ | Twitter

<< 【Access】VBAで宅急便送り状番号の妥当性チェックを実装してみる。
【コンピュータ】(Windows7 64bit)XAMPPをインストール時にApachが起動しない場合の対応方法。 >>

[関連エントリ 最新5]

[Google PR]


[最新エントリ 5]

>>トップページ
人気カテゴリ:AccessTips SQLServer CakePHP iPad
過去ログ(全記事一覧)

コメント
コメントする(お気軽にどうぞ)









この記事のトラックバックURL
トラックバック
カテゴリー
プロフィール
お問い合わせ
Powered by NINJA TOOLS
links
recent comment
  • 【Access】vbaでhmacが正しく計算できた!!
    まさ (06/01)
  • 【Access】AccessReportMailメール送信時のポートを25から587へ
    わら (05/31)
  • 【SQLServer】超シンプル!再帰CTE(共通テーブル式)で連続データを作成する。
    sazi (09/08)
  • 【あまっちゃお】Amazon商品検索「あまっちゃお」プロジェクト始動。Ver00-06-00 β
    カメちゃん (07/31)
  • 【Access】あれ?DoCmd.RunCommand acCmdSaveRecordの内部仕様が変わった?
    花姉 (03/17)
  • 【Access】実行中のmdb(自分自身)をバックアップコピーする方法。
    亀 (02/06)
  • 【雑記】Amazonでの注文時、TMGさん発送にご注意を。納期を守れない可能性あり!
    管理人 (01/31)
  • 【雑記】Amazonでの注文時、TMGさん発送にご注意を。納期を守れない可能性あり!
    あ (01/31)
  • 【雑記】Amazonでの注文時、TMGさん発送にご注意を。納期を守れない可能性あり!
    K (11/13)
  • 【VAIOP】VaioXと両持ちできるものすっっごくマニアックなケース。当たり前ですが在庫限り。(笑)
    管理人 (08/04)
recent trackback
  • 【Access】2003安全でない式がブロックされていませんとセキュリティーレベル。
    awgs Foundry (10/29)
  • 【VAIOtypeP】液晶保護シートは、新車のカバーではない。レイアウト社液晶/天板保護フィルムセットRT-VP1FS1
    XMLがキライ。 (04/09)
  • Vistaから、LinkStation(NAS)にアクセスできません。
    そのほかいろいろ (09/06)