実行中のIEを探し制御

Sub All_IE_Close()

	Dim ObjIE As Object
	Dim ObjShell As Object
	Dim ObjWindow As Object

	Set ObjShell = CreateObject("Shell.Application")
	'全shellをチェックしてIEならClose
	For Each ObjWindow In ObjShell.Windows
		If TypeName(ObjWindow.Document) = "HTMLDocument" Then ObjWindow.Quit
	Next

	'1だけメインのIEを起動する
	Set ObjIE = CreateObject("InternetExplorer.application")
	ObjIE.Visible = True
	ObjIE.Navigate "http://xxxxxxxxxx"

End Sub

Sub Go()

	Dim ObjIE As Object
	Dim ObjShell As Object
	Dim ObjWindow As Object
	Dim wkTEXT As String, intISR As Integer
	Dim txtISR As String, intEnd As Integer, Y As Integer

	Set ObjShell = CreateObject("Shell.Application")
	'全shellをチェック
	For Each ObjWindow In ObjShell.Windows
		'IEならば
		If TypeName(ObjWindow.Document) = "HTMLDocument" Then
			Set ObjIE = ObjWindow
			'フィールドに値をセット&クリック&3秒待ち
			ObjIE.Document.forms(1).Item("xxxx").Value = "xxx"
			ObjIE.Document.all("xxxxx").click
			Application.Wait Time:=Now + TimeValue("00:00:03")
			'結果HTMLから必要な文字列の取り出し
			wkTEXT = ObjIE.Document.body.innerText
			intISR = InStr(1, wkTEXT, "ISR ")
			intEnd = InStr(1, wkTEXT, "xxxx")
			'値が見つかれば
			If intISR > 0 Then
				txtISR = Trim(Mid(wkTEXT, intISR + 4, intEnd – intISR – 6))
				Debug.Print txtISR
			End If
			'強制終了
			MsgBox "Done!"
			End
		End If
	Next

End Sub

文字列検索関数

Function Xlookup(CUST_NAME As String, GetColumn As String)

	Dim X As Integer, CY As Long
	'カラム番号取得
	GetColumn = UCase(GetColumn)
	If GetColumn < "A" Or GetColumn > "O" Then
		'A~O以外はエラー
		Xlookup = "Err Column"
		Exit Function
	End If

	' calculate column Aが1列目とする
	X = Asc(UCase(GetColumn)) – 64
	'顧客名取得&株 削除&Trim
	CUST_NAME = Trim(Replace(CUST_NAME, "(株)", ""))
	'検索して見つかったY座標取得
	CY = find_string(CUST_NAME)
	If CY = 0 Then
		'見つからなかった場合
		Xlookup = "UnFound"
		Exit Function
	End If
	'見つかった場合は指定の列の値を返す
	Xlookup = Sheets("MST").Cells(CY, X)

End Function

Function find_string(NM As String)
	Dim Y As Long
	'見つからなかった場合はエラーにならないようにする
	On Error Resume Next
	If IsError(Sheets("MST").Cells.Find(What:=NM).Row) Then
		'見つからなかった場合はゼロを返す
		Y = 0
	Else
		'見つかった場合はY座標を返す
		Y = Sheets("MST").Cells.Find(What:=NM).Row
	End If

	On Error GoTo 0
	find_string = Y

End Function