Importar imagem site para uma celula da planilha
Enviado: Ter Mar 24, 2020 6:22 pm
Boa tarde,
Antes de mais nada quero parabenizar o Tomás por compartilhar seus conhecimentos conosco, estou apredendendo muito aqui. Veio isso não tem preço, muito obrigado mesmo!
Mas vamos ao assunto, com base nos videos estou desenvolvendo uma planilha para importar dados e imagem de pagina na internet. A informações com dados ok, mas a imagem não consigo de forma alguma!
Por favor me ajudem, já estou a uma semana nisso rs...
Segue vba:
Sub Macro1()
'
Application.ScreenUpdating = False
Dim IElocation As String
Dim nRegistro As String
Dim nMarca As String
Dim vDados As String
Dim vSituacao As String
Dim W As Worksheet
Dim IE As Object Dim Ultcel As Range
Dim A As Integer
Dim col As Integer
Dim ln As Long
Dim Tabela As Object
Dim tb As String
Planilha1.Rows("4:" & Rows.Count).ClearContents
Set IE = CreateObject("InternetExplorer.application")
With IE
.Visible = True
.navigate "https://gru.inpi.gov.br/pePI"
IEVerify IE
Application.Wait Now + TimeSerial(0, 0, 2)
'TELA DE LOGIN
'ie.document.all("T_Login").innerText = "ZZZZZZ"
'ie.document.all("T_Senha").innerText = "ZZZZZZ"
IE.document.all.Item("F_LoginCliente").submit
Do While IE.Busy
Loop
Application.Wait Now() + TimeValue("00:00:2")
'TELA OPÇÃO SERVIÇOS DE MARCAS INPI
With IE
.navigate "https://gru.inpi.gov.br/pePI/jsp/marcas ... ocesso.jsp"
.Visible = True
End With
'TELA CONSULTA BASE DE DADOS
Do While IE.Busy
Loop
Application.Wait Now() + TimeValue("00:00:01")
IE.document.all("NumPedido").Value = "916715787"
Application.Wait Now() + TimeValue("00:00:01")
IE.document.all.Item("botao").Click
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 2)
'TELA RESULTADO CONSULTA BASE DE DADOS
Do While IE.Busy
Loop
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 2)
Dim elemUnique, elemCollection As Object
Set elemCollection = IE.document.getElementsByTagName("a")
For Each elemUnique In elemCollection
If elemUnique.innerText Like "*916715787*" Then
'MsgBox elemUnique.innerText
elemUnique.Click
Exit For
End If
Next elemUnique
Do While IE.Busy
Loop
tb = .document.all("principal").outerHTML
Application.Wait Now + TimeSerial(0, 0, 2)
PutInClipboard tb
'.Quit
End With
Set IE = Nothing
With Planilha1
.Cells(4, 2).PasteSpecial
.DrawingObjects.Delete
End With
MsgBox "Dados importados com sucesso"
End Sub
Private Sub IEVerify(ByRef IE As Object)
While IE.Busy Or IE.readyState <> 4: Application.Wait Now + TimeSerial(0, 0, 1): Wend
End Sub
Private Sub PutInClipboard(ByVal Data As String)
Dim oClip As MSForms.DataObject
Set oClip = New DataObject
oClip.SetText Data
oClip.PutInClipboard
End Sub
Antes de mais nada quero parabenizar o Tomás por compartilhar seus conhecimentos conosco, estou apredendendo muito aqui. Veio isso não tem preço, muito obrigado mesmo!
Mas vamos ao assunto, com base nos videos estou desenvolvendo uma planilha para importar dados e imagem de pagina na internet. A informações com dados ok, mas a imagem não consigo de forma alguma!
Por favor me ajudem, já estou a uma semana nisso rs...
Segue vba:
Sub Macro1()
'
Application.ScreenUpdating = False
Dim IElocation As String
Dim nRegistro As String
Dim nMarca As String
Dim vDados As String
Dim vSituacao As String
Dim W As Worksheet
Dim IE As Object Dim Ultcel As Range
Dim A As Integer
Dim col As Integer
Dim ln As Long
Dim Tabela As Object
Dim tb As String
Planilha1.Rows("4:" & Rows.Count).ClearContents
Set IE = CreateObject("InternetExplorer.application")
With IE
.Visible = True
.navigate "https://gru.inpi.gov.br/pePI"
IEVerify IE
Application.Wait Now + TimeSerial(0, 0, 2)
'TELA DE LOGIN
'ie.document.all("T_Login").innerText = "ZZZZZZ"
'ie.document.all("T_Senha").innerText = "ZZZZZZ"
IE.document.all.Item("F_LoginCliente").submit
Do While IE.Busy
Loop
Application.Wait Now() + TimeValue("00:00:2")
'TELA OPÇÃO SERVIÇOS DE MARCAS INPI
With IE
.navigate "https://gru.inpi.gov.br/pePI/jsp/marcas ... ocesso.jsp"
.Visible = True
End With
'TELA CONSULTA BASE DE DADOS
Do While IE.Busy
Loop
Application.Wait Now() + TimeValue("00:00:01")
IE.document.all("NumPedido").Value = "916715787"
Application.Wait Now() + TimeValue("00:00:01")
IE.document.all.Item("botao").Click
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 2)
'TELA RESULTADO CONSULTA BASE DE DADOS
Do While IE.Busy
Loop
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 2)
Dim elemUnique, elemCollection As Object
Set elemCollection = IE.document.getElementsByTagName("a")
For Each elemUnique In elemCollection
If elemUnique.innerText Like "*916715787*" Then
'MsgBox elemUnique.innerText
elemUnique.Click
Exit For
End If
Next elemUnique
Do While IE.Busy
Loop
tb = .document.all("principal").outerHTML
Application.Wait Now + TimeSerial(0, 0, 2)
PutInClipboard tb
'.Quit
End With
Set IE = Nothing
With Planilha1
.Cells(4, 2).PasteSpecial
.DrawingObjects.Delete
End With
MsgBox "Dados importados com sucesso"
End Sub
Private Sub IEVerify(ByRef IE As Object)
While IE.Busy Or IE.readyState <> 4: Application.Wait Now + TimeSerial(0, 0, 1): Wend
End Sub
Private Sub PutInClipboard(ByVal Data As String)
Dim oClip As MSForms.DataObject
Set oClip = New DataObject
oClip.SetText Data
oClip.PutInClipboard
End Sub