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

Resultado de Consulta em nova janela do Internet Explorer.

A Web está aí, não há como negar. Ela é onipresente em praticamente toda operação eletrônica realizada nos dias de hoje. Como não podia ser diferente, o Excel, ferramenta máxima para analistas e profissionais das mais diversas áreas do mercado precisa estar alinhado com esta necesssidade. E ele está! Neste forum, o debate é focado em expor dúvidas, sugestões, modelos de código e exemplos de uso do Excel na Integração com tecnologias Web.
Odirlei.Canhoni
Acabou de chegar
Acabou de chegar
Mensagens: 3
Registrado em: Qua Ago 19, 2020 6:07 am

Resultado de Consulta em nova janela do Internet Explorer.

Mensagem por Odirlei.Canhoni »

Caros, boa noite.
Estou engatinhando ainda no VBA e confesso que "ensaiei" um tempo pra postar aqui no fórum, pois pesquisei bastante e ainda não encontrei uma resposta.

Criei um código para consultar os prazos de entrega do SEDEX.
Ele funciona, mas o problema é que o resultado é exibido em uma nova guia, eis que eu não consigo "capturar" dessa nova janela.

Vou colocar meu código aqui e anexar o arquivo...
Sub ConsultaPrazoSedex()


Set ie = CreateObject("internetexplorer.application")

'Endereço para consulta
ie.navigate "http://www2.correios.com.br/sistemas/precosPrazos/"
ie.Visible = True

Do While ie.busy And ie.readyState <> "READYSTATE_COMPLETE"
DoEvents
Loop

'Digita o CEP de Origem
ie.document.getElementsByTagName("Input")(2).Value = Planilha2.Cells.Range("A3").Value
'Digita o CEP de Destino
ie.document.getElementsByTagName("Input")(3).Value = Planilha2.Cells.Range("B3").Value
'Seleciona a caixa de combinação
ie.document.getElementsByTagName("Select")(0).Focus
'Seleciona o item Sedex
ie.document.getElementsByTagName("Select")(0).Item(23).Selected = True
'Clica no item Sedex
ie.document.getElementsByClassName("btn2 f2col float-right")(0).Click
    
Do While ie.busy And ie.readyState <> "READYSTATE_COMPLETE"
DoEvents
Loop


ie.Quit

End Sub

Será que alguém poderia me ajudar ?

Agradeço.
Anexos
CONSULTA PRAZOS.rar
(19.34 KiB) Baixado 219 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.


Raygsson
Manda bem
Manda bem
Mensagens: 118
Registrado em: Sex Jan 31, 2020 8:06 pm

Re: Resultado de Consulta em nova janela do Internet Explorer.

Mensagem por Raygsson »

Tente desta forma:

Código: Selecionar todos


Dim Shell As Object
Set Shell = CreateObject("Shell.Application")
For Janela = 1 To Shell.Windows.Count
    Set IE = Shell.Windows.Item(Janela)
    If Not IE Is Nothing Then
        If IE.LocationURL = "http://www2.correios.com.br/sistemas/precosPrazos/prazos.cfm" Then Exit For
    End If
Next

prazo = IE.document.getElementsByClassName("destaque")(0).getElementsByTagName("td")(0).innertext

Anexos
Teste.JPG
Teste.JPG (46.4 KiB) Exibido 3968 vezes


Odirlei.Canhoni
Acabou de chegar
Acabou de chegar
Mensagens: 3
Registrado em: Qua Ago 19, 2020 6:07 am

Re: Resultado de Consulta em nova janela do Internet Explorer.

Mensagem por Odirlei.Canhoni »

Raygsson, boa tarde.
Funcionou !
Muito obrigado, valeu mesmo !


Raygsson escreveu: Qui Set 03, 2020 10:49 pm Tente desta forma:

Código: Selecionar todos


Dim Shell As Object
Set Shell = CreateObject("Shell.Application")
For Janela = 1 To Shell.Windows.Count
    Set IE = Shell.Windows.Item(Janela)
    If Not IE Is Nothing Then
        If IE.LocationURL = "http://www2.correios.com.br/sistemas/precosPrazos/prazos.cfm" Then Exit For
    End If
Next

prazo = IE.document.getElementsByClassName("destaque")(0).getElementsByTagName("td")(0).innertext



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