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.
Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
VBA dando loop na mensagem de erro e não preenchendo a planilha
-
- 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
- Anexos
-
- Controle de Cargas.rar
- (1.02 MiB) Baixado 208 vezes