在 VBA Web 浏览器中停止 Javascript

Stop Javascript in a VBA Web Browser

本文关键字:Javascript 浏览器 VBA Web      更新时间:2023-09-26

我正在尝试从特定网页获取所有表。为此,我构建了一个VBA宏(PatenteCatcher)来输入一些信息。并浏览网站,直到找到包含这些表格的特定网页。包含特定网页 URL 的字符串是 urlfocado3。 然后,我调用第二个VBA宏,称为PegaTabelas,它捕获此特定表中的每个表并将它们保存在工作表上。宏做得很好。但是,问题是:在包含表格的网页中,有与特定表格行绑定的javascript,打开了一些我真的不想要的额外信息。

简而言之,我想在该页面中禁用特定的JavaScript。如果不可能,我想禁用特定页面中的所有javascript。不幸的是,我无法在IE上禁用脚本,因为没有它,我的代码将无法正常工作。

这是我想禁用的页面中的 HTML 代码:

<a href="javascript:void(0)" onmouseout="hideMe('classificacao0')" onmouseover="showMe('classificacao0','hidden')" onClick="DisableHide()" class=normal>
                            C07C 229/40    <b>;&nbsp;</b>
                        </a>
                        <div  id="classificacao0" style="BACKGROUND-COLOR: #ffffff; BORDER-BOTTOM: #000000 1px; BORDER-LEFT: #000000 1px; BORDER-RIGHT: #000000 1px; BORDER-TOP: #000000 1px; HEIGHT: 20px; POSITION: absolute; VISIBILITY: hidden; WIDTH: 300px; Z-INDEX: 10; layer-background-color: #FFFFFF">
                            <table width="100%" border="1" cellspacing="0" cellpadding="5" bordercolor="#006363" bordercolorlight="#B5D6AD">
                                <tr><td align="center" bgcolor="#B5D6AD">
                                        <table width="100%" border="0" cellspacing="1" cellpadding="0">
                                            <tr>
                                                <td width="30"><a href="javascript:EnableHide('classificacao0');"><img src="../jsp/imagens/bt_layer.gif" width="26" height="16" border="0" name="class"></a></td>
                                            </tr>
                                        </table>
                                    </td>
                                </tr>
                                <tr>
                                    <td align="left" bgcolor="#ffffff">
                                <font class="normal"><center><b>C07C 229/40    </b></center>
                                <hr size=2 width="100%" align="center" color="#B5D6AD">
                                    Compostos contendo grupos amino e carboxila ligados ao mesmo esqueleto de carbono <br>com grupos amino ligados a átomos de carbono de pelo menos um anel aromático de seis membros e grupos carboxila ligados a átomos de carbono acíclicos do mesmo esqueleto de carbono;
                                </font>
                                </td>
                                </tr>
                            </table>
                        </div>

这是我的宏:

Sub PatenteCatcher()
    Dim IE As Object
    Dim strURL As String
    Dim strUsername As String
    Dim strPassword As String
    Dim PedidoPatente As Object
    Dim urlfocado As String
    Dim urlfocado2 As String
    Dim urlfocado3 As String
    Dim ApertaBotao As Object
    Dim patentefoco As String
    Dim doc As Object

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    strURL = "https://gru.inpi.gov.br/pPI/servlet/LoginController?action=login"
    strURL2 = "https://gru.inpi.gov.br/pPI/jsp/patentes/PatenteSearchBasico.jsp"
    IE.navigate strURL
    While IE.Busy
        DoEvents
    Wend

    IE.navigate strURL2
    While IE.Busy
        DoEvents
    Wend
         While IE.Busy
        DoEvents
    Wend
    Posicao = Worksheets("Operação").Cells(1, 2)
IE.document.getElementsByName("NumPedido").Item.innerText = “9600975”
     While IE.Busy
        DoEvents
    Wend
Set ApertaBotao = IE.document.all.Item("botao")
        ApertaBotao.Value = "submit"
        ApertaBotao.Click
I = 1
While IE.Busy
        DoEvents
Wend
I = 1
Set linkCollecting = IE.document.getElementsByTagName("A")
    For Each link In linkCollecting
    Worksheets("Rascunho").Cells(I, 1) = link
    I = I + 1
    Next
urlfocado = Worksheets("Rascunho").Cells(8, 1)
If urlfocado <> "" Then
    IE.navigate urlfocado
    Set doc = IE.document
    While IE.Busy
        DoEvents
    Wend
    Worksheets("Rascunho").Activate
    Call PegaTabelas(doc)
Else
    MsgBox ("Erro! A base de dados do INPI nao esta disponivel. Nada de novo ate aqui.")
    Worksheets("Rascunho").Activate
End If
While IE.Busy
    DoEvents
Wend
''IE.Quit

结束子

    Sub PegaTabelas(doc As Object)
        Dim ws As Worksheet
        Dim rng As Range
        Dim tbl As Object
        Dim rw As Object
        Dim cl As Object
        Dim tabno As Long
        Dim nextrow As Long
        Dim I As Long
        Set ws = Worksheets("Rascunho")
        For Each tbl In doc.getElementsByTagName("TABLE")
            tabno = tabno + 1
            nextrow = nextrow + 1
            Set rng = ws.Range("B" & nextrow)
            rng.Offset(, -1) = "Table " & tabno
            For Each rw In tbl.Rows
                For Each cl In rw.Cells
                    rng.Value = cl.outerText
                    Set rng = rng.Offset(, 1)
                    I = I + 1
                Next cl
                nextrow = nextrow + 1
                Set rng = rng.Offset(1, -I)
                I = 0
            Next rw
        Next tbl
        ws.Cells.ClearFormats
    End Sub

您可以尝试这样的方式来删除弹出窗口div 的内容。 我假设他们有一个像"分类可可[数字]"这样的 ID

Dim divs
Set divs = doc.getElementsByTagName("div")
for each div in divs
   if div.id like "classificacao*" then 
       div.innerHTML=""
   end if
next div