直接讀取IE畫面的HTML

小舖文http://www.blueshop.com.tw/board/FUM200501271723350KG/BRD20120828125154N0V.html
參考http://www.blueshop.com.tw/board/show.asp?subcde=BRD20110304202432XK1&fumcde=FUM200501271723350KG

滑鼠移到IE並讀取URL  再背景去讀取 HTML

'在模組裡
'------------------------------------------------------------------
Declare Function FindWindow Lib "User32.dll" Alias "FindWindowA" (ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Declare Function FindWindowEx Lib "User32.dll" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Declare Function GetForegroundWindow Lib "User32.dll" () As Long
Declare Function SendMessage Lib "User32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Declare Function EnumChildWindows Lib "User32.dll" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByRef lParam As Long) As Boolean
Declare Function GetWindowText Lib "User32.dll" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function GetClassName Lib "User32.dll" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Function EnumChildProc(ByVal hwnd As Long, ByRef lParm As Long) As Boolean

    Dim c As String
    c = Space(256)
 
    Dim cr As Integer
    cr = GetClassName(hwnd, c, 256)
 
    If Left(c, cr) = "Address Band Root" Then
        lParm = hwnd
        EnumChildProc = 0
    Else
        EnumChildProc = 1
    End If

End Function

'在FORM1
'------------------------------------------------------------------
Private Const WM_GETTEXT = &HD
Private Function scan() As Long
    Dim h As Long
    h = 0
    Dim f As Long
    f = GetForegroundWindow()
    Dim c As String
    c = Space(256)
    Dim cr As Long
    cr = GetClassName(f, c, 256)
    If Left(c, cr) = "IEFrame" Then
    Dim sr As Boolean
    sr = EnumChildWindows(f, AddressOf EnumChildProc, h)
    h = FindWindowEx(h, 0, "Edit", vbNullString)
    End If
    scan = h
End Function

Private Sub messagebox()

Dim myIE As Object

Set myIE = CreateObject("InternetExplorer.Application")

With myIE
    .Navigate URL:=Label1.Caption
 
    Do While .Busy Or .readystate <> 4: DoEvents: Loop
 
    MsgBox .Document.Body.Innerhtml
    .Quit
End With

End Sub

Private Sub Timer1_Timer()
    Dim h As Long
    h = scan()
    Dim t As String
    t = Space(256)
    Dim r As Long
    r = SendMessage(h, WM_GETTEXT, 256, t)
    Label1.Caption = Left(t, r)
 
    If Trim(Label1.Caption) <> Empty Then messagebox
End Sub