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ページ内のデータから文字列「 １件目」を検索。
For n = 0 To IE.Document.all.Length - 1
If IE.Document.all(n).InnerText = " １件目" Then
Exit For
End If
Next n
x = j '列
y = i + PageNo * 10 '行
'HTMLページ内のデータから「 １件目」の直前までジャンプしその直前から文字列「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
