[Resolvido]Formulário auto preenchido via Chrome

Bom dia pessoal tenho esse VBA que faz a consulta no site da receita via Internet Explorer


Ja peguei alguns exempos em varios locais na net e aqui tb, porem sem sucesso de abrir o chome e jogar os dados, alguem tem ou pode por favor me dar um help,


Obrigado desde já



Private Sub TIPO_DE_SOLICITAÇÃO_AfterUpdate()
Me.Texto180 = Forms![LOGADO]![Usuário]
'Me.Texto211 = [Combinação207] & "-" & [CNPJ]

Dim objIE As InternetExplorer
Dim elem, tbl, tr
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.StatusBar = False
.Toolbar = False
.Width = 800
.Height = 600
.Resizable = False
.AddressBar = False
.visible = True
.Top = 60
.Left = 560
.Navigate "http://www.receita.fazenda.gov.br/PessoaJuridica/CNPJ/cnpjreva/Cnpjreva_Solicitacao2.asp"
Do While .Busy Or _
.ReadyState <> 4
DoEvents
Loop
.Document.all.Item("cnpj").innertext = Me.CNPJ
reset:

For Each tr In .Document.getElementsByTagName("tr")
If tr.innertext = "Erro na Consulta - Esclarecimentos adicionais. " Then GoTo reset
Next
'Aguarda até a página ser carregada totalmente----

Do While objIE.LocationURL <> "http://servicos.receita.fazenda.gov.br/Servicos/cnpjreva/Cnpjreva_Comprovante.asp"
Loop
If objIE.LocationURL = "http://servicos.receita.fazenda.gov.br/Servicos/cnpjreva/Cnpjreva_Comprovante.asp" Then
Do While .Busy Or .ReadyState <> READYSTATE_COMPLETE:
Loop
End If
Dim tamanho As Integer

For Each elem In .Document.all
If elem.tagName = "TABLE" Then
Set tbl = elem
If tbl.Rows.Length >= 1 Then
Set tr = tbl.Rows(0)
If tr.Cells.Length >= 1 Then
If Not InStr(tbl.Rows(0).innertext, "REPÚBLICA FEDERATIVA DO BRASIL") > 0 Then
If InStr(tr.Cells(0).innertext, "NÚMERO DE INSCRIÇÃO") > 0 Then
End If
'Nome da Empresa
If InStr(tr.Cells(0).innertext, "NOME EMPRESARIAL") > 0 Then
Me.RAZÃO_SOCIAL = ret_carac(Mid(Trim(tbl.Rows(0).Cells(0).innertext), 21))
End If

'Nome da Fantasia
If InStr(tr.Cells(0).innertext, "TÍTULO DO ESTABELECIMENTO (NOME DE FANTASIA)") > 0 Then
Me.NOME_FANTASIA = ret_carac(Mid(Trim(tbl.Rows(0).Cells(0).innertext), 50))
End If

'Atividade Econômica Primária da Empresa
If InStr(tr.Cells(0).innertext, "CÓDIGO E DESCRIÇÃO DA ATIVIDADE ECONÔMICA PRINCIPAL") > 0 Then
Me.CNAE = ret_carac(Mid(Trim(tbl.Rows(0).Cells(0).innertext), 55))
'Me.CNAE = Left(Me.CNAE, 3) & Mid(Me.CNAE, 5, 2) & "-" & Mid(Me.CNAE, 8, 1) & "/" & Mid(Me.CNAE, 10)
End If


'Atividade Econômica Secundária da Empresa
If InStr(tr.Cells(0).innertext, "ATIVIDADES ECONÔMICAS SECUNDÁRIAS") > 0 Then
Me.DESCRIÇÃO_AU = tbl.Rows(0).Cells(0).innertext
'Me.DESCRIÇÃO_AU = Left(Me.DESCRIÇÃO_AU, 2) & Mid(Me.DESCRIÇÃO_AU, 4, 2) & "-" & Mid(Me.DESCRIÇÃO_AU, 7, 1) & "/" & Mid(Me.DESCRIÇÃO_AU, 9, 2) & Mid(Me.DESCRIÇÃO_AU, 10)
End If


End If
End If
End If
End If


Next
objIE.Quit
DoCmd.RunSQL "INSERT INTO [tblLicenciamentoCNAE] ( CNPJ, SERVIDOR, N_DOC, TIPO_DOC, D_SOLICITAÇÃO, CNAE, DESCRIÇÃO, CNAE_PRINCIPAL )" & _
"SELECT [Formulários]![formLicenciamento]![Texto209] AS CNPJ" & _
",[Formulários]![formLicenciamento]![TEXTO180] AS SERVIDOR" & _
",[Formulários]![formLicenciamento]![PROCESSO] AS N_DOC" & _
",[Formulários]![formLicenciamento]![TEXTO83] AS TIPO_DOC" & _
", DATE() AS D_SOLICITAÇÃO" & _
",mid ([Formulários]![formLicenciamento]![CNAE],1,11) AS CNAE" & _
",mid ([Formulários]![formLicenciamento]![CNAE],14) AS descrição" & _
", ('SIM') AS CNAE_PRINCIPAL"


DoCmd.RunSQL "DELETE tblLicenciamentoCNAE.CNAE " & vbCrLf & _
"FROM tblLicenciamentoCNAE " & vbCrLf & _
"WHERE (((tblLicenciamentoCNAE.CNAE)=""Nã i-f/rm""));"


DoCmd.RunSQL "INSERT INTO [tblLicenciamento_Protocolos] ( CNPJ, LOG_SERVIDOR_LANÇAMENTO, n_doc_capa, TIPO_DOC_capa, D_SOLICITAÇÃO, LOG_DATA_LANÇAMENTO, ASSUNTO)" & _
"SELECT [Formulários]![formLicenciamento]![Texto209] AS CNPJ" & _
",[Formulários]![formLicenciamento]![TEXTO180] AS LOG_SERVIDOR_LANÇAMENTO" & _
",[Formulários]![formLicenciamento]![PROCESSO] AS N_DOC_CAPA" & _
",[Formulários]![formLicenciamento]![TEXTO83] AS TIPO_DOC_CAPA" & _
",[Formulários]![formLicenciamento]![TEXTO0] AS D_SOLICITAÇÃO" & _
",[Formulários]![formLicenciamento]![logdata] AS LOG_DATA_LANÇAMENTO" & _
",[Formulários]![formLicenciamento]![TIPO_DE_SOLICITAÇÃO] AS ASSUNTO"

'Me.email.SetFocus




End With

Set objIE = Nothing

Dim j, k%
j = Split(Me.DESCRIÇÃO_AU, vbCrLf)
For k = 1 To UBound(j)

CurrentDb.Execute "INSERT INTO tblLicenciamentoCNAE (CNPJ ,CNAE , Descrição, SERVIDOR, D_SOLICITAÇÃO, TIPO_DOC, CNAE_PRINCIPAL)" & _
"values ('" & Me.Combinação207 & "-" & Me.CNPJ & "', '" & (j(k)) & " ' , '" & Mid(j(k), 14) & "','" & Me.Texto180 & "','" & Date & "','" & Texto83 & "','" & "não" & "');"


DoCmd.RunSQL "DELETE tblLicenciamentoCNAE.CNAE " & vbCrLf & _
"FROM tblLicenciamentoCNAE " & vbCrLf & _
"WHERE (((tblLicenciamentoCNAE.CNAE)=""Nã i-f/rm""));"

Next
'Refresh
MsgBox "Atividade registrada com sucesso !"
End Sub

O VBA não interage com o Chrome, apenas com o Internet Explorer.

Com o Microsoft Edge teria algum jeito será ?

Desconheço. VBA só com IE mesmo.

Talvez um outro membro saiba de algum outro serviço ou modo. Aguardemos.

Tem um exemplo aqui no repositório de consulta de CNPJ, funciona muito bem! Agora no celular não consigo achar mas amanhã coloco o link aqui

Obrigado pessoal, achei um exemplo aqui no forum e ja fiz a adaptção para o que eu precisava, desculpem nao ter respondido antes....


https://www.maximoaccess.com/t33325-consulta-cnpj-webservice-de-dados-de-cnpj-api-publica-com-resposta-em-json

Obrigado a todos