VBA - FORM MATTERS ALL DATA, EXCEPT IMAGE

Status
Not open for further replies.

LuisOrtin

New Member
Joined
Mar 27, 2020
Messages
27
Office Version
  1. 2019
Platform
  1. Windows
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

  • VBA.png
    VBA.png
    154.6 KB · Views: 12

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Status
Not open for further replies.

Forum statistics

Threads
1,214,805
Messages
6,121,656
Members
449,045
Latest member
Marcus05

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