もくじ
モジュール共通部分
Option Explicit
'**************************************************************
'Day5.総合演習
' (1)連続的な画面遷移を行う
' (2)オンライン画面のデータをワークシートに一覧化する
' (3)ワークシート一覧データをオンライン画面に登録する
'**************************************************************
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
(1)連続画面遷移
'サンプル5.1.1_連続画面遷移
Public Sub navigate1To3()
Dim ie As InternetExplorer
Dim Anchor As HTMLAnchorElement
'IE起動
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
'画面1を開いて待ち受け
ie.Navigate2 "http://macrogirls.net/sample/screen1.html"
Do While ie.Busy Or ie.ReadyState < READYSTATE_COMPLETE
DoEvents
Loop
Sleep 2000 '動作を見るために2秒待ち(動作上は不要)
'リンクをクリックして画面2へ移動&待ちうけ
For Each Anchor In ie.document.getElementsByTagName("A")
If Anchor.innerText = "画面2へ進む" Then
Anchor.Click
Exit For
End If
Next
Do While ie.Busy Or ie.ReadyState < READYSTATE_COMPLETE
DoEvents
Loop
Sleep 2000 '動作を見るために2秒待ち(動作上は不要)
'ボタンをクリックして画面3へ移動&待ちうけ
ie.document.forms("TargetForm").elements("toScreen3").Click
Do While ie.Busy Or ie.ReadyState < READYSTATE_COMPLETE
DoEvents
Loop
End Sub
(2)連続画面遷移(開いた子画面の待ちうけ)
'サンプル5.1.2_連続画面遷移(開いた子画面の待ちうけ)
Public Sub waitChild()
Dim ie As InternetExplorer
Dim ieChild As InternetExplorer
'IE起動→サンプル親画面に遷移
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.Navigate2 "http://macrogirls.net/sample/parent.html"
'待ちうけ
Do While ie.Busy Or ie.ReadyState < READYSTATE_COMPLETE
DoEvents
Loop
'子画面を開くボタンをクリック
ie.document.forms("TargetForm").elements("OpenChild").Click
'子画面を探す
Do While ieChild Is Nothing
Set ieChild = Day2.getIE("子画面の例")
DoEvents
Loop
'子画面の待ちうけ(ただしgetIEでDocumentを参照しており、基本的には不要)
Do While ieChild.Busy Or ieChild.ReadyState < READYSTATE_COMPLETE
DoEvents
Loop
Debug.Print ieChild.document.body.innerHTML
End Sub
(3)オンライン画面のデータをワークシートに一覧化する
'サンプル5.2.1_オンライン画面のデータをワークシートに一覧化する
Public Sub お客さまデータ一覧化()
Dim ie As InternetExplorer
Dim AllAnchors As Object
Dim i, NextIndex, printrow As Integer
'IE起動→オンライン画面へ遷移→一覧画面へ遷移
Set ie = getOnline
ie.document.frames("Footer").document.forms("Commands").elements("ShowList").Click
waitNavigation ie
'画面に対して処理(次の画面がある限り処理)
printrow = 3
Do
NextIndex = -1 '次の画面へのAタグインデックス値をリセット
'すべてのAタグに対して処理(インデックスを利用)
For i = 0 To ie.document.frames("Main").document.getElementsByTagName("A").Length - 1
'Aタグコレクションへの参照を格納(再格納)
Set AllAnchors = ie.document.frames("Main").document.getElementsByTagName("A")
'Cを含むリンクの場合クリックしてお客さま情報へ遷移
If InStr(AllAnchors(i).href, "C") > 0 Then
AllAnchors(i).Click
waitNavigation ie
'お客さま情報のシート転記
printCustomerData ie, printrow
printrow = printrow + 1
'次の画面へのリンクの場合はインデックスを保管しておく
ElseIf InStr(AllAnchors(i).innerText, "次へ") > 0 Then
NextIndex = i
End If
Next
'次のページに遷移
If NextIndex >= 0 Then
ie.document.frames("Main").document.getElementsByTagName("A")(NextIndex).Click
waitNavigation ie
End If
DoEvents
'次の画面へ遷移している場合はループ
Loop While NextIndex >= 0
End Sub
'サンプル5.2.2_詳細画面転記処理
Private Sub printCustomerData(ie As InternetExplorer, printrow As Integer)
Dim Anchor As HTMLAnchorElement
Dim TDs As Object
Dim i As Integer
Dim CID, CName, CAddress, CMagic, CFamiliar, SalesDept As String
'すべてのTDタグを評価し、取得対象項目のデータを変数に格納
Set TDs = ie.document.frames("Main").document.getElementsByTagName("TD")
For i = 0 To TDs.Length - 1
Select Case Trim(TDs(i).innerText)
Case "お客さまID": CID = TDs(i + 1).innerText
Case "氏名": CName = TDs(i + 1).innerText
Case "住所": CAddress = TDs(i + 1).innerText
Case "魔法": CMagic = TDs(i + 1).innerText
Case "使い魔": CFamiliar = TDs(i + 1).innerText
Case "営業担当": SalesDept = TDs(i + 1).innerText
End Select
Next
'取得データをワークシートに転記
Sheet2.Cells(printrow, 1).Value = CID
Sheet2.Cells(printrow, 2).Value = CName
Sheet2.Cells(printrow, 3).Value = CAddress
Sheet2.Cells(printrow, 4).Value = CMagic
Sheet2.Cells(printrow, 5).Value = CFamiliar
Sheet2.Cells(printrow, 6).Value = SalesDept
'一覧画面に戻る
For Each Anchor In ie.document.frames("Main").document.getElementsByTagName("A")
If InStr(Anchor.innerText, "戻る") > 0 Then
Anchor.Click
waitNavigation ie
Exit Sub
End If
Next
End Sub
(4)ワークシート一覧データをオンライン画面に登録する
'5.3_ワークシート一覧データをオンライン画面に登録する
Public Sub 一覧データオンライン登録()
Dim ie As InternetExplorer
Dim i As Integer
'IE起動→オンライン画面へ遷移
Set ie = getOnline
'各レコードを登録
i = 3
Do While Sheet2.Cells(i, 1) <> ""
'新規登録画面へ遷移
ie.document.frames("Footer").document.forms("Commands").elements("Register").Click
waitNavigation ie
'レコードデータをフォームに貼り付け・送信
With ie.document.frames("Main").document.forms("RegData")
.elements("CustomerID").Value = Sheet2.Cells(i, 1)
.elements("CustomerName").Value = Sheet2.Cells(i, 2)
.elements("Address").Value = Sheet2.Cells(i, 3)
.elements("Magic").Value = Sheet2.Cells(i, 4)
.elements("Familiar").Value = Sheet2.Cells(i, 5)
.elements("SalesDepartment").Value = Sheet2.Cells(i, 6)
.submit
End With
waitNavigation ie
i = i + 1
DoEvents
Loop
End Sub
総合演習で利用する汎用処理
'サンプルオンラインシステム起動処理
Private Function getOnline() As InternetExplorer
Dim ie As InternetExplorer
'IE起動→オンライン画面へ遷移
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.Navigate2 "http://macrogirls.net/sample/webonline.html"
waitNavigation ie
Set getOnline = ie
End Function
'サンプルオンラインシステム汎用待ちうけ処理
Private Sub waitNavigation(ie As InternetExplorer)
Dim i As Integer
'IE待ちうけ
Do While ie.Busy Or ie.ReadyState < READYSTATE_COMPLETE
DoEvents
Loop
'フレームセットのドキュメント待ちうけ
Do While ie.document.ReadyState <> "complete"
DoEvents
Loop
'フレーム内のドキュメント待ちうけ
For i = 0 To ie.document.frames.Length - 1
Do While ie.document.frames(i).document.ReadyState <> "complete"
DoEvents
Loop
Next
End Sub