VBA 打开多个空白浏览器选项卡并填充 InnerHTML

问题描述 投票:0回答:1

我的目标是打开一个空白浏览器选项卡并通过innerHTML 使用.html 代码填充它。我在第一个实例上取得了成功,但在第二个实例(及此后)上,空白选项卡被打开,但“innerHTML”被发布到我的第一个实例。我无法在新打开的空白标签中发帖。

这是我的代码。我已经简化了。

Public Sub Test()
    Dim Ie As Object
    Set Ie = CreateObject("InternetExplorer.Application")
  
    Dim one As String
        one = "<title>one</title>"
    Dim two As String
        two = "<title>two</title>"

    With Ie
        .Visible = True
        .Navigate "about:blank"
        .Document.body.innerHTML = one

        .Visible = True
        .Navigate "about:blank", 2048&
        .Document.body.innerHTML = two
    End With

End Sub
vba innerhtml paste
1个回答
0
投票

试试这个:

Public Sub Test()
    Dim Ie As Object
    Set Ie = CreateObject("InternetExplorer.Application")
  
    With Ie
        .Visible = True
        .Navigate "about:blank1"
        .Navigate "about:blank2", 2048&
    End With
    
    Application.Wait Now + TimeSerial(0, 0, 2)
    
    Set Ie = GetIE("about:blank1")
    If Not Ie Is Nothing Then Ie.document.Body.innerHTML = "<span>one</span>"
    
    Set Ie = GetIE("about:blank2")
    If Not Ie Is Nothing Then Ie.document.Body.innerHTML = "<span>two</span>"

End Sub


'get a reference to an existing IE window, given a partial URL
Function GetIE(sLocation As String) As Object

    Dim objShell As Object, objShellWindows As Object, o As Object
    Dim sURL As String
    Dim retVal As Object

    Set retVal = Nothing
    Set objShell = CreateObject("Shell.Application")
    Set objShellWindows = objShell.Windows

    For Each o In objShellWindows
        sURL = ""
        On Error Resume Next  'because may not have a "document" property
        'Check the URL and if it's the one you want then
        ' assign the window object to the return value and exit the loop
        sURL = o.document.Location
        On Error GoTo 0
        If sURL Like sLocation & "*" Then
            Set retVal = o
            Exit For
        End If
    Next o

    Set GetIE = retVal

End Function
© www.soinside.com 2019 - 2024. All rights reserved.