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
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