LoginSignup
0
0

More than 3 years have passed since last update.

VBA=IE=NTbJS自分用ノートなので、目障りだったらごめんなさい

Posted at

VBAでtitleを判定し、iframeのelementをstringに変換して探します。

Option Explicit
Private Declare PtrSafe Function setforegroundwindow Lib "user32" (ByVal hwnd As LongPtr) As Long

Public flg As Boolean
Public IE As InternetExplorer

Sub frameup()
Dim gettitle As String
Dim getcstitle As String
Dim HTMLString As String

getcstitle = "Firefox"
Set IE = getcs(getcstitle)
HTMLString = getString(IE)

' Call numlockon
End Sub

Private Function getcs(gettitle As String) As InternetExplorer
Dim shl As Object
Dim nowtitle As String
Dim win As Object

Set shl = CreateObject("Shell.Application")
For Each win In shl.Windows
    If TypeName(win.document) = "HTMLDocument" Then
        If InStr(win.LocationURL, "Firefox") > 0 Then
            Set IE = win
            flg = True
            Exit For
        End If
    End If
Next
End Function

End Function

Private Function getcim(gettitle As String) As InternetExplorer
Dim shl As Object
Dim nowtitle As String
Dim win As Object

Set shl = CreateObject("Shell.Application")
For Each win In shl.Windows
    If TypeName(win.document) = "HTMLDocument" Then
        getcstitle = ""
        Do
            getcstitle = win.document.Title
            If getcstitle <> "" Then Exit Do
        Loop
        If InStr(win.LocationURL, "") <> 0 Then
            setforegroundwindow (win.hwnd)
            Set IE = win
            Do While IE.Busy Or IE.redystate < READYSTATE_COMPLETE
                DoEvents
            Loop
        End If
    End If
Next
End Function

End Function

Private Function getElement(htmlDoc As HTMLDocument) As String
Dim element As Object

If InStr(htmlDoc.locaion, "Firefox") <> 0 Then
    For Each element In htmlDoc.all
        If UCase(element.tagName) = "INPUT" Then
            If element.Name = "" And element.Value = "Firefox" Then
                Application.WindowState = xlMinimized
                element.Click
            End If
        End If
    Next
End If

If InStr(htmlDoc.Location, "Google") <> 0 Then
    For Each element In htmlDoc.all
        Select Case UCase(element.tagName)
           Case "INPUT"
        End Select
    Next
End If
End Function

End Function

Private Function getString(iecontents As Object, Optional depth As Long = 0) As String
Dim htmlDoc As HTMLDocument
Dim ret As String
Dim ii As Integer

On Error Resume Next

Set htmlDoc = iecontents.document
If Not htmlDoc Is Nothing Then
    ret = getElement(htmlDoc)
    For i = 0 To htmlDoc.frames.Length - 1

        ret = getString(htmlDoc.frames(i), depth + 1)
    Next
End If
Exit Function

End Function

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0