[Resolvido]Ajuda com código VBA - que pega dados da receita

Bom dia pessoal, adaptei um código que peguei num exemplo aqui no forum, ele faz a pesquisa no site da receita federal e pega as informações e coloca no formulário do access, porem estou com um pequeno problema, que quando ha cnaes secundários ele não consigo organizá-los um abaixo do outro para colocar numa tabela, porque cada linha de cnae tem q ser um registro, ele esta trazendo as informações assim em uma caixa de texto:

90.01-9-99 - Artes cênicas, espetáculos e atividades complementares
não especificadas anteriormente 73.19-0-02 - Promoção de vendas

preciso que ele traga as informações da seguinte forma:
90.01-9-99 - Artes cênicas, espetáculos e atividades complementares não especificadas anteriormente
73.19-0-02 - Promoção de vendas

Eis o código completo, se alguém puder ajudar desde já agradeço


obrigado

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://www.receita.fazenda.gov.br/PessoaJuridica/CNPJ/cnpjreva/Cnpjreva_Comprovante.asp"
Loop
If objIE.LocationURL = "http://www.receita.fazenda.gov.br/PessoaJuridica/CNPJ/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, "CÓDIGO E DESCRIÇÃO DAS ATIVIDADES ECONÔMICAS SECUNDÁRIAS") > 0 Then
Me.DESCRIÇÃO_AU = ret_carac(Mid(Trim(tbl.Rows(0).Cells(0).innerText), 57))
End If

End If
End If
End If
End If

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



Next



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,9) AS CNAE" & _
",mid ([Formulários]![formLicenciamento]![CNAE],14) AS descrição" & _
", ('SIM') AS CNAE_PRINCIPAL"

' DoCmd.SetWarnings True 'recoloca avisos do access"


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

'Next
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"


MsgBox "Atividade registrada com sucesso !"

Me.email.SetFocus
Refresh
End With
objIE.Quit
Set objIE = Nothing
End Sub

Boa tarde,
Vejo vários DoCmd.RunSQL
Qual acrescenta a linha com os dados que devem ser desdobrados?

Pegue nessa linha e separe as 2 informações através da função InStr para identificar onde deve fazer a separação e execute 2 instruções

Caro Alexandre, são estas duas linhas abaixo, mas não entendi o que você disse.


",mid ([Formulários]![formLicenciamento]![CNAE],1,9) AS CNAE" & _
",mid ([Formulários]![formLicenciamento]![CNAE],14) AS descrição" & _

antes da receita federal mudar o site, o código abaixo funcionava perfeitamente, agora estou readaptando conforme postado anteriormente e não ta dando certo.

eis o código antigo
im elem
Dim tbl
Dim tr

For Each elem In Me!WebBrowser4.Document.all
DoCmd.SetWarnings False 'tirar avisos do acces
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, "NOME EMPRESARIAL") > 0 Then
Me.RAZÃO_SOCIAL = WebBrowser4.Document.all.tags("b")(.innertext
End If

If InStr(tr.Cells(0).innertext, "NOME DE FANTASIA") > 0 Then
Me.NOME_FANTASIA = WebBrowser4.Document.all.tags("b")(9).innertext

End If

If InStr(tr.Cells(0).innertext, "ATIVIDADE ECONÔMICA PRINCIPAL") > 0 Then
Me.CNAE = WebBrowser4.Document.all.tags("b")(10).innertext
Me.CNAE = Left(Me.CNAE, 2) & Mid(Me.CNAE, 4, 2) & "-" & Mid(Me.CNAE, 7, 1) & "/" & Mid(Me.CNAE, 9, 2) & Mid(Me.CNAE, 10)

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,9) AS CNAE" & _
",mid ([Formulários]![formLicenciamento]![CNAE],14) AS descrição" & _
", ('SIM') AS CNAE_PRINCIPAL"

DoCmd.SetWarnings True 'recoloca avisos do access"


Refresh

End If

If InStr(tr.Cells(0).innertext, "ATIVIDADES ECONÔMICAS SECUNDÁRIAS") > 0 Then
Me.DESCRIÇÃO_AU = tbl.Rows(0).Cells(0).innertext


Dim j, k%

' curto = 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)

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.Texto209 & "', '" & Left(j(k), 2) & Mid(j(k), 4, 2) & "-" & Mid(j(k), 7, 1) & "/" & Mid(j(k), 9, 2) & " ' , '" & Mid(j(k), 14) & "','" & Me.Texto180 & "','" & Date & "','" & Texto83 & "','" & "não" & "');"
Refresh

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

Next
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"
Refresh







MsgBox "Atividade registrada com sucesso !"
End If
End If
End If
End If
End If
Next
Me.email.SetFocus
Refresh

End Sub

que dados traz cada parte para o caso que apresentou (90.01-9-99 - Artes cênicas, espetáculos e atividades complementares não especificadas anteriormente 73.19-0-02 - Promoção de vendas)?

eles são inseridos na tabela tblLicenciamentoCNAE, sendo os números na coluna CNAE e o texto na coluna DESCRIÇÃO




90.01-9-99 - Artes cênicas, espetáculos e atividades complementares não especificadas anteriormente
73.19-0-02 - Promoção de vendas

mas qual parte do código traz essa informação?

Estes cnaes vem da pagina da receita federal, como ainda estou testando como CNPJ 06932517000103 no link: http://www.receita.fazenda.gov.br/PessoaJuridica/CNPJ/cnpjreva/Cnpjreva_Solicitacao2.asp

o resultado da pesquisa vem na página, http://www.receita.fazenda.gov.br/PessoaJuridica/CNPJ/cnpjreva/Cnpjreva_Comprovante.asp que é jogado no caso em especifico no campo Me.DESCRIÇÃO_AU todo bagunçado,

'Atividade Econômica Secundária da Empresa
If InStr(tr.Cells(0).innerText, "CÓDIGO E DESCRIÇÃO DAS ATIVIDADES ECONÔMICAS SECUNDÁRIAS") > 0 Then
Me.DESCRIÇÃO_AU = ret_carac(Mid(Trim(tbl.Rows(0).Cells(0).innerText), 57))

abri a ligação e não aparece nada
tem de indicar onde carrega a informação

a informação vem do resultado da consulta do CNPJ, e são jogadas nas textbox do formulario, todos estao certos menos esta que pode vir vazio ou com varios cnaes e atividade, ai vai depender de cada cnpj,


vou postar o banco para voce dar uma olhada pode ser ?

Sera que atraves do webservice como por exemplo https://www.receitaws.com.br/v1/cnpj/27865757000102 é mais facil? o duro que ele ele gera um arquivo json e faz o download automatico

Poderia rodar sua aplicação por ai, e colocar um stop no momento que ele entra na condição da atividade secundária ?
Dando um print no valor que está vindo do " tbl.Rows(0).Cells(0).innerText " ?

Não tenho idéia de como fazer, poderia me dar uma luz por favor? Obrigado desde já

Consegue salvar a pagina HTML como arquivo e postar aqui ?

Obs.: Botão direito na pagina no seu navegador e escolha salvar pagina como.

Bom dia philipp.moreira eis o link da página, se puder me ajudar desdes ja agradeço

https://www.receitaws.com.br/v1/cnpj/27281922000170

wmantovani, algum avanço?

Aguardamos...

Bom dia DamascenoJr., deu tudo certo sim, muito obrigado e desculpa nao ter dado o devido retorno à época.