| |
InternetExplorerで新しく開いたWindowを制御するのに
良い案があれば教えてください。
長いですので、お時間のある方お付き合い頂ければと思います。
週末は家族サービスでレスを確認できません・・・
先にお詫び致します。
いろいろなサイトを参考にして２案作ってみたのですが、
なんとなく迂遠な処理のような気がしています。
リンク元の親Windowを参照するプロパティがあるのでしょうか？
例では、新しいWindowのタイトル名が一定となっていますが、
実際はSessionIDのようなタイトル名になっており案１ではできません。
タイトル名以外のプロパティでも常に一定になっているモノが確認できませんでした。
案２だと動作はするのですが、なんだか無駄な処理をたくさんしている気がしてます。
Collectionを使用しているのは、親Windowから複数の子Windowに対応する為です。
'（案１）
'参照設定なし
'標準モジュール
Sub IE_Test1()
Dim objIE As Object '親IEオブジェクト
Dim objTgt As Object 'Targetのオブジェクト(IE)
Dim Elt As Object 'Loop用
Dim StrURL As String 'URL
''禁止語句に引っかかるのでこちらのTopページのアドレスを入れてください
StrURL = "XXXX://www.vbalab.net/"
Set objIE = CreateObject("InternetExplorer.application")
With objIE
.Navigate StrURL
.Visible = True
'5秒待つ
Application.Wait Now + TimeSerial(0, 0, 5)
DoEvents
'読み込み終了を待つ
Do While .Busy = True
DoEvents
Loop
'念のため、もう１回 DoEvents
DoEvents
'入力するInputBoxを探す
With .Document
For Each Elt In .all
If TypeName(Elt) = "HTMLInputElement" Then
If Elt.Name = "txtSearch" Then
Elt.Value = "VBA"
End If
End If
Next Elt
'Formを送信
.Forms(0).Submit
End With
End With
'5秒待つ
Application.Wait Now + TimeSerial(0, 0, 5)
DoEvents
'#ここで新しく開いたWindowをつかみたい。
'#開かれるWindowのタイトルが一定なら
'#Shell.Applicationでできる。
Set objTgt = Ie_Get("モーグ - テキスト検索")
If Not objTgt Is Nothing Then
'つかめていたら左上に移動してみる
objTgt.Left = 1
objTgt.Top = 1
Else
MsgBox "Targetを取得できませんでした"
End If
MsgBox "終了"
Set objIE = Nothing
Set objTgt = Nothing
End Sub
Function Ie_Get(ByVal Doc_Title)
Dim objShl As Object 'Shell.Application
Dim objWin As Object 'Loop用
'Shellオブジェクト生成
Set objShl = CreateObject("Shell.Application")
'WindowをLoop
For Each objWin In objShl.Windows
If TypeName(objWin.Document) = "HTMLDocument" Then
If objWin.Document.Title = Doc_Title Then Exit For
End If
Next
Set Ie_Get = objWin
Set objShl = Nothing
Set objWin = Nothing
End Function
'(案１）End
'（案２）
'参照設定MicroSoft Internet Controls
'
'#Class1モジュール'
Option Explicit
Private WithEvents m_IE As InternetExplorer
Private m_Coll As Collection '子Window用のCollection
Private Sub Class_Initialize()
Set m_IE = New InternetExplorer
m_IE.Visible = True
Set m_Coll = New Collection
End Sub
'm_IEをナビゲートするメソッド
Public Sub Navigate(StrURL As String)
With m_IE
.Navigate StrURL
'読み込み終了を待つ
Do While .Busy = True
DoEvents
Loop
'念のため、もう１回 DoEvents
DoEvents
End With
End Sub
'm_IE.Documentを参照するプロパティ
Public Property Get Document()
Set Document = m_IE.Document
End Property
'コレクションをカウントするプロパティ
Public Property Get Count()
Count = m_Coll.Count
End Property
'コレクションItem(子Window）を参照するプロパティ
Public Property Get Wins(ByVal Index As Integer)
Set Wins = m_Coll(Index)
End Property
''イベント処理
'新しいWindowを開く前に発生するイベント
'Objectをすりかえて(?)Collectionに追加
'そのままppDispをSetするとNothingになる
Private Sub m_IE_NewWindow2(ppDisp As Object, Cancel As Boolean)
Dim NewIE As InternetExplorer
Set NewIE = New InternetExplorer
Set ppDisp = NewIE
NewIE.Visible = True
m_Coll.Add Item:=NewIE
End Sub
'#Class1モジュールEnd'
'#標準モジュール'
Option Explicit
Sub IE_Test2()
Dim Cl_IE As Class1 '親IEオブジェクト(Class1）
Dim objTgt As Object 'Targetのオブジェクト(IE)
Dim Elt As Object 'Loop用
Dim StrURL As String 'URL
''禁止語句に引っかかるのでこちらのTopページのアドレスを入れてください
StrURL = "XXXX://www.vbalab.net/"
Set Cl_IE = New Class1
With Cl_IE
.Navigate StrURL
'5秒待つ
Application.Wait Now + TimeSerial(0, 0, 5)
DoEvents
'入力するInputBoxを探す
With .Document
For Each Elt In .all
If TypeName(Elt) = "HTMLInputElement" Then
If Elt.Name = "txtSearch" Then
Elt.Value = "VBA"
End If
End If
Next Elt
'Formを送信
.Forms(0).Submit
End With
End With
'5秒待つ
Application.Wait Now + TimeSerial(0, 0, 5)
DoEvents
Set objTgt = Cl_IE.Wins(1)
If Not objTgt Is Nothing Then
'つかめていたら左上に移動してみる
objTgt.Left = 1
objTgt.Top = 1
Else
MsgBox "Targetを取得できませんでした"
End If
MsgBox "終了"
Set Cl_IE = Nothing
Set objTgt = Nothing
End Sub
|
|
ハチ
- 07/6/8(金) 14:04 -
