Vídeo recomendado
https://youtu.be/diWPPPhW-9E

VBA dando loop na mensagem de erro e não preenchendo a planilha

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
amurilosantos
Acabou de chegar
Acabou de chegar
Mensagens: 4
Registrado em: Qui Mar 28, 2019 4:54 pm

VBA dando loop na mensagem de erro e não preenchendo a planilha

Mensagem por amurilosantos »

Pessoal, estou montando uma planilha para tratamento de logística e com certeza depois vou compartilhar pra vocês aqui por quê acho que vai ajudar a muitos.
Agora estou fazendo com que a mesma integre com o site do correios e busque os endereços pelo CEP, show de bola.
A busca já esta sendo feita corretamente, mas as informações não estão alimentando a planilha e a minha tratativa de erro esta entrando em loop.
A macro que esta sendo executada é essa:

Sub pega_tabela()

Set ie = CreateObject("InternetExplorer.Application")
With ie
.Width = 800
.Height = 600
.Resizable = False
.AddressBar = False
.Top = 60
.Left = 540
.Visible = True
.Navigate "http://www.buscacep.correios.com.br/sistemas/buscacep/"
Do Until .readyState = 4: DoEvents: Loop
Set myTextField = .Document.all.Item("relaxation")
myTextField.Value = Sheets("Menus_de_Cadastros").Range("B17")
ie.Document.Forms(0).Submit

Do Until .readyState = 4: DoEvents: Loop
Do While .Busy: DoEvents: Loop
Set doc = ie.Document

Do While ie.LocationURL <> "http://www.buscacep.correios.com.br/sis ... dereco.cfm"
Loop

If ie.LocationURL = "http://www.buscacep.correios.com.br/sis ... dereco.cfm" Then
Do While .Busy Or .readyState <> READYSTATE_COMPLETE:
Loop
End If

puxa_dados doc, 3
'.Quit

End With
End Sub
Sub puxa_dados(d, n)

'd é o documento
'n é a tabela de onde os dados vão ser importados

Dim elemento As Object ' elemento do documento html
Dim tabela As Object ' é a tabela
Dim linha As Object ' é a linha da tabela
Dim celula As Object ' é a célula da tabela
Dim I As Long
Dim J As Long
Dim dados(5) As String
Dim x As Integer

x = 1


On Error GoTo erro:
For Each elemento In d.all

If elemento.nodeName = "TABLE" Then
J = J + 1
End If

If J = n Then
Set tabela = elemento
'tabno = tabno + 1
nextrow = nextrow + 1
Set Rng = ("A" & nextrow)

For Each linha In tabela.Rows

For Each celula In linha.Cells

dados(x) = celulainnertext
'Para lançar em planilha use o código abaixo
Menus_de_Cadastros.Select
Rng.Value = celula.innertext
Set Rng = Rng.Offset(, 1)
I = I + 1
x = x + 1

Next celula

nextrow = nextrow + 1
Set Rng = Rng.Offset(1, -I)
I = 0

Next linha
Exit For

End If

Next elemento

trata_end = Split(dados(1), "-")
Sheets("Menus_de_Cadastros").Range("B18") = trata_end(0)
Sheets("Menus_de_Cadastros").Range("B21") = dados(2)
Sheets("Menus_de_Cadastros").Range("B22") = dados(3)
Sheets("Menus_de_Cadastros").Range("B23") = dados(4)
Sheets("Menus_de_Cadastros").Range("B17") = dados(5)

Exit Sub

erro: MsgBox "CEP não encontrado, favor digitar novamente"

End Sub

É necessário habilitar no módulo desenvolvedor, em ferramentas>referências a opção de Microsoft Internet Control para que as funções rodem corretamente.
Em anexo segue a planilha.
Anexos
Controle de Cargas.rar
(1.02 MiB) Baixado 201 vezes


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder