スモールビジネスのIT日誌

• (2010-03-02 10:17:35)

前にExcel上の伝票番号から「クロネコヤマトの荷物お問い合わせシステム」を自動で検索し、結果をExcelに書き戻すVBAを作成した。

当時はIE6で、IE6用のVBAだった。しかし、何かとエラーが気になりだしたIE6をついにIE8にアップグレード。現行のVBやVBAスクリプトに影響があるのでなるべくIE6で通してきたが、観念してIE8に移行。

予想通りVBAで書かれた自動ログインなどのスクリプトがエラーを起こすようになった。IE7からタブ型ブラウザーになったことが原因として多いようだ。

「クロネコヤマト荷物問合せ」自動検索VBAの修理を行った。

これは人様の公開されたコードを参考に、特に三流君のページを参考にパーツを切り貼りして作成。三流君様にはこの場を借りてお礼申し上げたい。


【クロネコヤマト伝票番号の取得方法】
・「送り状発行ソフトB2」起動

・「送り状発行ソフトB2」トップ画面->「出荷データ検索」ボタン

・「出荷データ検索」->「外部出力」

・「外部出力」->「csvファイル」か「excelファイル」にてダウンロード



【VBAソース】
Private Sub CommandButton4_Click()

'IE8を起動し「クロネコヤマトの荷物お問い合わせシステム」へ。
'Shell.Applicationオブジェクトをセット。
Dim Shell As Object
Dim IE As Object
Set Shell = CreateObject("Shell.Application")
Set IE = CreateObject("InternetExplorer.Application")

IE.Navigate2 "http://toi.kuronekoyamato.co.jp/cgi-bin/tneko?init"

'Excelシート内の選択された任意のセルから開始するためにアクティブなセルの行番号・列番号を採取。

Dim i As Integer, j As Integer, FormNo As Integer, PageNo As Integer, ExitFlag As Integer

i = ActiveCell.Row '行番号
j = ActiveCell.Column '列番号

PageNo = 0
'-------------------------------
'Excel<->WEB画面の読み込み・書き込みを10個単位で行う
'-------------------------------
Do
'IEの起動を待つ。
Do While IE.Busy Or IE.ReadyState <> 4
DoEvents
Loop
IE.Visible = True

'WEB画面の遷移変化のタイミング調整。
Application.Wait (Now + TimeValue("00:00:01"))

'-------------------------------
'最初の10個、Excel(読み込み)->WEB画面(書き込み)
'-------------------------------
'Excel->WEB画面(問い合わせフォーム)へ10個単位で、伝票番号入力
'Excel側に空欄の出現すればループを抜ける。
For FormNo = 1 To 10
If Cells(PageNo * 10 + FormNo - 1 + i, j) = "" Then
ExitFlag = 1
Exit For
End If
Shell.Windows.Item(Shell.Windows.Count - 1).Document.forms(0)(FormNo + 3).Value _
= Cells(PageNo * 10 + FormNo - 1 + i, j)
Next

'伝票番号を目視確認できるよう数秒待って問い合わせボタンをクリック。
Application.Wait (Now + TimeValue("00:00:01"))
Shell.Windows.Item(Shell.Windows.Count - 1).Document.forms(0)(2).Click
Do While IE.Busy Or IE.ReadyState <> 4
DoEvents
Loop

'フォームに入力した伝票番号をクリア
'「クロネコヤマトの荷物お問い合わせシステム」ページの「クリア」ボタンを押す
Shell.Windows.Item(Shell.Windows.Count - 1).Document.forms(0)(3).Click
Do While IE.Busy Or IE.ReadyState <> 4
DoEvents
Loop
'-------------------------------
'最初の10個、HTMLソース(読み込み)->Excel(書き込み)
'-------------------------------
Dim n As Integer, m As Integer, x As Integer, y As Integer
Dim strTNAME As String
'HTMLソース内のデータから文字列「　１件目」を検索。
'「クロネコヤマトの荷物お問い合わせシステム」ページのソース前半は余計なデータが多く飛ばすため
For n = 0 To IE.Document.all.Length - 1
If IE.Document.all(n).InnerText = "　１件目" Then
Exit For
End If
Next n
y = i + PageNo * 10 '行
x = j '列

'HTMLソース内のデータから「　１件目」の直前までジャンプしその直前から文字列「TR」を検索。
For m = n - 1 To IE.Document.all.Length - 1
strTNAME = IE.Document.all(m).tagname

'文字列「TR」の出現でExcel上でy方向に1つ進む。
If strTNAME = "TR" Then
If Not IE.Document.all(m).InnerText = "" Then
y = y + 1 '行
x = j '列
ElseIf IE.Document.all(m + 10).InnerText = "" Then
Exit For
End If
End If
'文字列「TD」の出現ごとにExcel上でx方向に1つずつ進みながら、_
'HTMLソース内のデータをExcelに書き込む。
'空欄「TD」の連続出現でループを抜ける。
If strTNAME = "TD" Then
If Not IE.Document.all(m).InnerText = "" Then
x = x + 1
Cells(y, x) = "'" & IE.Document.all(m).InnerText
'ElseIf IE.Document.all(m + 3).InnerText = "" Then
'Exit For
End If
End If
'文字列「TABLE」でHTMLソース・データ読み込みループを抜ける。
'Document.all(m + 3).InnerText = ""にてループを抜けるが最後10件目は空欄の連続がないため。
If strTNAME = "TABLE" Then
Exit For
End If

Next m

'-------------------------------
'次の10単位に移動
'-------------------------------
If ExitFlag = 1 Or Cells(PageNo * 10 + i, j) = "" Then
Exit Do
Else
Shell.Windows.Item(Shell.Windows.Count - 1).Document.forms(0)(3).Click
End If
PageNo = PageNo + 1
Loop
Set IE = Nothing
Set Shell = Nothing
ThisWorkbook.Saved = True
End Sub