求问：excel VBA对一个已经打开的网页进行操作

Posted 2023-05-18

求问：当前已经打开了多个IE网页窗口,如何对“指定的”（依照网页名称指定）一个网页执行以下操作：
1.将这个网页的地址换成另一个，并转到新的地址。
2.将这个网页的源码保存到一个文本文件中。

'准备工作：1.用IE打开百度
          2.调用函数GetIE

'代码搜索标题包含百度的IE窗口，然后控制打开hao123，最后保存为c:\\myhtml.txt
Option Explicit
  '
  '   工程要引用  "Microsoft   HTML   Object   Library"
  '
    
Private Type UUID
      Data1   As Long
      Data2   As Integer
      Data3   As Integer
      Data4(0 To 7)       As Byte
End Type
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetClassName Lib "user32" _
      Alias "GetClassNameA" ( _
      ByVal hWnd As Long, _
      ByVal lpClassName As String, _
      ByVal nMaxCount As Long) As Long
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, lParam As Long) As Long
  
Private Declare Function RegisterWindowMessage Lib "user32" _
      Alias "RegisterWindowMessageA" ( _
      ByVal lpString As String) As Long
  
Private Declare Function SendMessageTimeout Lib "user32" _
      Alias "SendMessageTimeoutA" ( _
      ByVal hWnd As Long, _
      ByVal msg As Long, _
      ByVal wParam As Long, _
      lParam As Any, _
      ByVal fuFlags As Long, _
      ByVal uTimeout As Long, _
      lpdwResult As Long) As Long
              
Private Const SMTO_ABORTIFHUNG = &H2
  
Private Declare Function ObjectFromLresult Lib "oleacc" ( _
      ByVal lResult As Long, _
      riid As UUID, _
      ByVal wParam As Long, _
      ppvObject As Any) As Long
Dim IEhwnd As Long
Dim IEserver As Long
'
'   IEDOMFromhWnd
'
'   Returns   the   IHTMLDocument   interface   from   a   WebBrowser   window
'
'   hWnd   -   Window   handle   of   the   control
'
Function IEDOMFromhWnd() As IHTMLDocument
Dim IID_IHTMLDocument     As UUID
Dim hWnd   As Long
Dim lRes   As Long
Dim lMsg   As Long
Dim hr     As Long
    '   Find   a   child   IE   server   window
    EnumWindows AddressOf EnumWindowProc, ByVal 0
    If IEhwnd Then EnumChildWindows IEhwnd, AddressOf EnumChildProc, ByVal 0
    If IEserver Then hWnd = IEserver Else Exit Function
    
    '   Register   the   message
    lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
    '   Get   the   object   pointer
    Call SendMessageTimeout(hWnd, lMsg, 0, 0, _
                    SMTO_ABORTIFHUNG, 1000, lRes)
    If lRes Then
          '   Initialize   the   interface   ID
          With IID_IHTMLDocument
                .Data1 = &H626FC520
                .Data2 = &HA41E
                .Data3 = &H11CF
                .Data4(0) = &HA7
                .Data4(1) = &H31
                .Data4(2) = &H0
                .Data4(3) = &HA0
                .Data4(4) = &HC9
                .Data4(5) = &H8
                .Data4(6) = &H26
                .Data4(7) = &H37
          End With
          '   Get   the   object   from   lRes
          hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, IEDOMFromhWnd)
    End If
End Function
  
Private Function IsIEServerWindow(ByVal hWnd As Long) As Boolean
Dim lRes     As Long
Dim sClassName     As String
    sClassName = GetClsName(hWnd)
    IsIEServerWindow = StrComp(sClassName, "Internet Explorer_Server", vbTextCompare) = 0
End Function
'返回窗口类名
Public Function GetClsName(ByVal hWnd As Long) As String
Dim lRes     As Long
Dim sClassName     As String
    sClassName = String$(200, 0)
    lRes = GetClassName(hWnd, sClassName, Len(sClassName))
    GetClsName = Left$(sClassName, lRes)
End Function
'返回窗口标题
Public Function GetWinTitle(ByVal lhWnd As Long) As String
    Dim MyStr As String
    MyStr = String(200, Chr$(0))
    GetWindowText lhWnd, MyStr, 200
    GetWinTitle = Left(MyStr, InStr(MyStr, Chr$(0)) - 1)
End Function
Function EnumWindowProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
Dim sIEtitle As String
    sIEtitle = GetWinTitle(hWnd)
    If InStr(1, sIEtitle, "百度") Then  '搜索标题包含baidu的窗口
        IEhwnd = hWnd
    Else
        EnumWindowProc = 1
    End If
End Function
Function EnumChildProc(ByVal hWnd As Long, lParam As Long) As Long
    If IsIEServerWindow(hWnd) Then
        IEserver = hWnd
    Else
        EnumChildProc = 1
    End If
End Function
Function GetIE() As Long
    Dim Doc As IHTMLDocument2
    Dim s As String
    Set Doc = IEDOMFromhWnd
    If Not Doc Is Nothing Then
        Doc.url = "http://www.hao123.com" '打开网页
        Do Until Doc.readyState = "complete"
            DoEvents
        Loop
        s = Doc.body.innerHTML
        Open "c:\\myhtml.txt" For Output As #1
        Print #1, s
        Close
    End If
End Function

参考技术A 如果这个网页是加载在excel里面的子窗体中的浏览器控件中，也许还能进行操作
如果想操作windows的浏览器，那是很难做到的，需要调用windowsAPI来遍历进程
你需要调整你的需求

如何用VBA判断另1个EXCEL表是不是已经打开

我有2个表，表1表2.我想用表1的按钮来打开另个表，但如果表2已经被打开，并且还没关闭，那么表1就继续其它操作，不再执行打开表2的语句。否则我每次操作，都会被问是否重新打开表2.
所以需要判断表2是否是打开状态。必须判断表2的当前状态。如果没打开，则执行打开命令。如果打开了，就进行其它语句操作。

应该是工作薄的打开问题，如果是同一工作薄的不同sheet，只要该工作薄打开，就 不存在工作表（sheet）是否打开的问题

判断表2（准确说法：工作薄2）是否打开，如下：（如打开，T2Open=true ）

dim T2Open as boolean
dim bTP

T2Open = false
For Each bTp In Workbooks
If bTp.Name = "表2" Then
T2Open =true
exit for
End If
Next bTp 参考技术A 是表还是工作簿啊
如果是工作簿，可以利用遍历工作簿集合进行判断是否打开。