< | >

ExcelからVBAで「クロネコ荷物問い合わせ」一括検索(IE6版)#4
  • (2009-05-04 18:38:53)
Excel<->IE。ダイナミックにデータのやり取りができる仕組みを準備してくれているMicrosoft社に感謝。

-------------------------------

Excelの発送リストから自動的に「ヤマトお問合せシステム」のフォームに伝票番号を打ち込んでステータスを一気に確認するIE6用VBAを先日作成した。

どうにか動いているが、やはり「ヤマトお問合せシステム」の検索結果をローカルのExcelファイルに書き戻すプログラムもほしくなり作成した。プログラマには朝飯前かもしれないが私の場合時間を消耗した。同じ環境で同じことをしている人がいるかもしれないので参考になればと思いソースを公開。

これは私の使っているリストに合わせているので他人のリストにそのまま使えるものではないし、現状では動作しているが、コードの文法や書き方には間違いやルール違反があると思う。私と同じ位のでレベルで、同じような悩みを抱いているみなさんに参考になれば幸いです。

'IE6用。Shell.Applicationオブジェクトをセット。

'IEを起動し「クロネコヤマトの荷物お問い合わせシステム」へ。

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

'-------------------------------

'(ページをめくるループ)

'-------------------------------

Do

'IEの起動を待つ。

Do While IE.Busy Or IE.ReadyState <> 4

DoEvents

Loop

IE.Visible = True

AppActivate "Microsoft Internet Explorer"



'WEB画面変化のタイミング調整。

Application.Wait (Now + TimeValue("00:00:02"))

'問い合わせフォームに順々にExcel伝票番号を入れるループ。

'Excel空欄で小ループを解除。

For FormNo = 1 To 10

If Cells(PageNo * 10 + FormNo - 1 + i, j) = "" Then

ExitFlag = 1

Exit For

End If

Shell.Windows.Item().Document.forms(0)(FormNo + 4).Value _

= Cells(PageNo * 10 + FormNo - 1 + i, j)

Next

'伝票番号を目視確認できるよう3秒待って問い合わせボタンをクリック。

Application.Wait (Now + TimeValue("00:00:02"))

Shell.Windows.Item().Document.forms(0)(3).Click

Do While IE.Busy Or IE.ReadyState <> 4

DoEvents

Loop

'-------------------------------

HTML_ANALYZING_LOOP:

'(HTMLページ・データ読み込みループ)ここまで。

'検索結果ページの読み込み開始。

'-------------------------------

Dim n As Integer, m As Integer, x As Integer, y As Integer

Dim strTNAME As String

'HTMLページ内のデータから文字列「 1件目」を検索。

For n = 0 To IE.Document.all.Length - 1

If IE.Document.all(n).InnerText = " 1件目" Then

Exit For

End If

Next n

x = j '列

y = i + PageNo * 10 '行

'HTMLページ内のデータから「 1件目」の直前までジャンプしその直前から文字列「TR」を検索。

For m = n - 1 To IE.Document.all.Length - 1

strTNAME = IE.Document.all(m).tagname

If strTNAME = "TR" Then

'文字列「TR」でExcel上でy方向に1つ進む。

If Not IE.Document.all(m).InnerText = "" Then

y = y + 1 '行

x = j '列

End If

End If

'文字列「TD」をExcel上でx方向に1つずつ進みながら、HTMLページ内のデータをExcelに書き込む。

If strTNAME = "TD" Then

If Not IE.Document.all(m).InnerText = "" Then

x = x + 1

Cells(y, x) = "'" & IE.Document.all(m).InnerText

End If

End If

'文字列「TABLE」でHTMLページ・データ読み込みループを抜ける。

If strTNAME = "TABLE" Then

Exit For

End If



Next m

'-------------------------------

'(HTMLページ・データ読み込みループ)ここまで。

'-------------------------------

PageNo = PageNo + 1

If ExitFlag = 1 Or Cells(PageNo * 10 + i, j) = "" Then

Exit Do

Else

Shell.Windows.Item().Document.forms(0)(3).Click

End If

Loop

'-------------------------------

'(ページをめくるループ)ここまで。

'-------------------------------

Set IE = Nothing

Set Shell = Nothing

ThisWorkbook.Saved = True

End Sub

ExcelからVBAで「クロネコ荷物問い合わせ」一括検索(IE6版)#4

ExcelからVBAで「クロネコ荷物問い合わせ」一括検索(IE6版)#3

ExcelからVBAで「クロネコ荷物問い合わせ」一括検索(IE6版)#2

ExcelからVBAで「クロネコ荷物問い合わせ」一括検索(IE6版)#1






<< クレジットカード情報をメールで送る#1< | >重複サイトのペナルティを受けないために >>
search
layout
admin

[▲page top]