Doubt VBA how to import internet image

LuisOrtin

New Member
Joined
Mar 27, 2020
Messages
27
Office Version
  1. 2019
Platform
  1. Windows
Eu tenho um VBA que importa dados de um formulário. Mas não consigo importar uma imagem. Alguém pode me ajudar, por favor?

A imagem está no endereço abaixo, mas só é possível através do VBA devido à necessidade de autenticação do sistema: https://gru.inpi.gov.br/pePI/servlet/LogoMarcasServletController?Action=image&codProcesso=3888141

Aqui está o 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 Inteiro
Dim col As Inteiro
Dim ln As Long
Dim Tabela As Object
Dim tb As String

Planilha1.Rows ("4:" & Rows.Count) .ClearContents
Defina IE = CreateObject ("InternetExplorer.application")
Com o IE
.Visible = True
.navigate "https://gru.inpi.gov.br/pePI"
IEVerify IE
Aguarde agora + TimeSerial (0, 0, 2)


'TELA DE LOGIN (não obrigatório)
'ie.document.all ("T_Login"). innerText = "ZZZZZZ"
'ie.document.all ("T_Senha"). innerText = "ZZZZZZ"
IE.document.all.Item ("F_LoginCliente"). Submit
Faça Enquanto IE.Busy
Ciclo
Application.Wait Now () + TimeValue ("00: 00: 2")

TELA DE OPÇÃO DE SERVIÇOS DE MARCA DO INPI
Com o IE
.navigate "https://gru.inpi.gov.br/pePI/jsp/marcas/Pesquisa_num_processo.jsp"
.Visible = True
Terminar com

TELA DE CONSULTA DA BASE DE DADOS
Faça Enquanto IE.Busy
Ciclo
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"). Clique em
Application.Wait TimeSerial (Hora (Agora ()), Minuto (Agora ()), Segundo (Agora ()) + 2)

'TELA DE RESULTADO CONSULTAR BASE DE DADOS
Faça Enquanto IE.Busy
Ciclo
Application.Wait TimeSerial (Hora (Agora ()), Minuto (Agora ()), Segundo (Agora ()) + 2)
Dim elemUnique, elemCollection As Object
Defina elemCollection = IE.document.getElementsByTagName ("a")
Para cada elemUnique In elemCollection
If elemUnique.innerText Like "* 916715787 *" Then
'MsgBox elemUnique.innerText
elemUnique.Click
Sair para
Fim se
Próximo elemUnique
Faça Enquanto IE.Busy
Ciclo

tb = .document.all ("principal"). outerHTML
Aguarde agora + TimeSerial (0, 0, 2)

PutInClipboard tb

'.Sair

Terminar com

Definir IE = Nada
Com Planilha1
.Células (4, 2) .PasteEspecial
.DrawingObjects.Delete

Terminar com
MsgBox "Dados importados com sucesso"
End Sub

Private Sub IEVerify (ByRef IE como objeto)
Enquanto IE.Busy ou 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
Definir oClip = New DataObject
oClip.SetText Data
oClip.PutInClipboard
End Sub
 

Attachments

  • 1585364391629.png
    1585364391629.png
    32 KB · Views: 8

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Excuse me, here's a question about the revised macro:

I have a VBA that imports data from a form. But I can't import an image. Can someone help me please?
The image is at the address below, but it is possible through VBA due to the need for system authentication: https://gru.inpi.gov.br/pePI/servlet/LogoMarcasServletController?Action=image&codProcesso=3888141


Private Sub btExecuta_Click()

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)

'LOGIN SCREEN It 's not mandatory
'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")

'INPI BRAND SERVICES OPTION SCREEN
With IE
.navigate "https://gru.inpi.gov.br/pePI/jsp/marcas/Pesquisa_num_processo.jsp"
.Visible = True
End With

'DATABASE CONSULTATION SCREEN
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)

'RESULT SCREEN CONSULT DATABASE
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

Attachments
 
Upvote 0
The situation really must be quite complex, because if the macro in the attachment is finalized in the form where this image, however when clicking with the mouse on the image it is not possible to obtain an image URL.

As for manual access by google chome it is possible to get aurl from the image. I’m already warning that you don’t take the image url and access that it will give an error, because the previous steps must be performed.

1) toegang: https://gru.inpi.gov.br/pePI/

2)I click the button with say continue

3) On this page you arrived (https://gru.inpi.gov.br/pePI/s…inController?action=login)) I click on the Brand option

4) On the page that opens (https://gru.inpi.gov.br/pePI/j…Pesquisa_num_processo.jsp) I enter the process number: 916715787

5) On the next page that opens, click on the number 916715787 (hyperlink)

6) Phew, and only then opens the form.(https://gru.inpi.gov.br/pePI/s…=detail&CodPedido=3888141)

7) In this form if I click on the image the image address will appear: https://gru.inpi.gov.br/pePI/s…image&codProcesso=3888141

Important information: Both in IE or Chrome it is possible to click on the image and paste it into excel as a bitmap. It is precisely this action that I need to do in the macro, since the rest of the information is already being extracted by this macro.
 
Upvote 0
Please someone help me, I'm on this project for several days!
 
Upvote 0

Forum statistics

Threads
1,214,983
Messages
6,122,583
Members
449,089
Latest member
Motoracer88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top