Stop Javascript in a VBA Web Browser
I'm trying to get all tables from a specific webpage. For that, I built a
VBA macro (PatenteCatcher) to input some info. and navigate thru the
website until he finds a specific webpage that contains those tables. The
string containing the specific's webpage URL is urlfocado3. Then, I call a
second VBA macro called PegaTabelas which captures every table in this
specific table and save them on a sheet. The macro is doing it well. But,
the thing is: inside the webpage that contains the tables, there is
javascript tied to a specific table line, opening some extra information
that I really doesn't want.
In short, I would like to disable a specific javascript inside that page.
If it isn't possible, I would like to disable all javascripts in the
specific page. Unfortunately, I can't disable scripting at IE since my
code won't do well without it.
Here is the HTML code from the page that I would like to disable:
<a href="javascript:void(0)" onmouseout="hideMe('classificacao0')"
onmouseover="showMe('classificacao0','hidden')" onClick="DisableHide()"
class=normal>
C07C 229/40 <b>; </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>
Here is my macros:
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
End Sub
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
No comments:
Post a Comment