Photo by
ugto310
【自分用】IE操作モジュール
【Version1.3】
更新日時：2021/6/27 14:04
【Version1.2】
更新日時：2021/6/20 18:56
【Version1.1】
更新日時：2021/6/20 18:20
【Version1.0】
更新日時：2021/6/20 18:02
↓最新版コード↓
Option Explicit
'---------------------------------関数リスト---------------------------------
'【Public】
'Create_IEObject
'Open_Page
'Wait_Open
'Get_IEObject
'ShowForeground
'Get_TagCollection
'Search_Text
'【Private】
'Get_HTMLDocumentObject
'Regexp_IETitle
'【その他】
'State
'---------------------------------関数リスト---------------------------------
'---------------------------------ウィンドウ操作関数の宣言---------------------------------
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function IsIconic Lib "user32" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function ShowWindowAsync Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
'---------------------------------ウィンドウ操作関数の宣言---------------------------------
Enum State
S_UNINITIALIZED = 0
S_LOADING
S_LOADED
S_INTERACTIVE
S_COMPLETE
End Enum
'↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓Public↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
'●IEオブジェクト作成
'引数で可視/不可視を指定する
Public Function Create_IEObject(boolVisible As Boolean) As Object: Set Create_IEObject = CreateObject("internetexplorer.application")
Create_IEObject.Visible = boolVisible
End Function
'●引数で指定したURLのページを開く
Public Sub Open_Page(objIE As Object, strURL As String)
objIE.Navigate strURL
End Sub
'●IEの操作を指定した段階まで待つ
'S_UNINITIALIZED 未完了状態
'S_LOADING ロード中状態
'S_LOADED ロード完了状態。操作不能状態
'S_INTERACTIVE 操作可能状態。
'S_COMPLETE 全データ読み込み完了状態
Public Sub Wait_Open(objIE As Object, TypeState As State, Optional boolPrint As Boolean)
With objIE
Do While .Busy Or .ReadyState < TypeState
If boolPrint = True Then Debug.Print .Busy & "：" & .ReadyState
Loop
End With
End Sub
'●既存のIEオブジェクト取得する
'strTarget 取得したいウィンドウタイトル
'strTargetType 取得したいウィンドウのタイプ 例：HTMLDocument
Public Function Get_IEObject(strPattern As String, strTargetType As String) As Object
Dim objShell As Object: Set objShell = CreateObject("shell.application")
Dim win As Object
For Each win In objShell.Windows
If TypeName(win.Document) = strTargetType Then
Select Case TypeName(win.Document)
Case "HTMLDocument": Set Get_IEObject = Get_HTMLDocumentObject(win.Document, strPattern)
End Select
End If
If Not Get_IEObject Is Nothing Then Exit For
Next win
Set objShell = Nothing
End Function
'●IEウィンドウを最前面に表示
Public Sub ShowForeground(objIE As Object)
If IsIconic(objIE.hWnd) Then
ShowWindowAsync objIE.hWnd, &H9
End If
SetForegroundWindow (objIE.hWnd)
End Sub
'●指定したタグを取得
Public Function Get_TagCollection(objIE As Object, strTagName As String) As Object
Dim objHTML As Object: Set objHTML = CreateObject("htmlfile")
Dim objHTMLDocument As Object: Set objHTMLDocument = objIE.Document
Set Get_TagCollection = objHTMLDocument.getelementsbytagname(strTagName)
Set objHTML = Nothing
Set objHTMLDocument = Nothing
End Function
'●タグコレクションの中から指定した文字列を取得する
Public Function Search_Text(objCollection As Object, strTargetText As String) As String
Dim v As Variant
For Each v In objCollection
If v.innertext = strTargetText Then
Search_Text = v.innertext
End If
Next v
End Function
'●strTagetTagNameで指定したHTMLタグオブジェクトを取得する
Public Function Get_TargetTages(strTargetTagName As String, objIE As Object) As Object
Set Get_TargetTages = objIE.Document.getelementsbytagname(strTargetTagName)
End Function
'↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑Public↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑
'↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓Private↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
'●正規表現で指定したHTMLDocumentを取得
Private Function Get_HTMLDocumentObject(objDoc As Object, strPattern As String) As Object
If Regexp_IETitle(objDoc.Title, strPattern) = True Then
Set Get_HTMLDocumentObject = objDoc
Else
Set Get_HTMLDocumentObject = Nothing
End If
End Function
'●HTMLDocumentのタイトルを正規表現でチェック
Private Function Regexp_IETitle(strTarget As String, strPattern As String) As Boolean
Dim objRe As Object: Set objRe = CreateObject("vbscript.regexp")
With objRe
.Global = True
.Pattern = strPattern
If .test(strTarget) = True Then Regexp_IETitle = True
End With
End Functionこの記事が気に入ったらサポートをしてみませんか？