PROGRAMA PAROU DE RESPONDER

JORGESALES 18/02/2016 21:24:53
#457874
Pessoal, estou
usando o código para consultar cnpj sem o Captcha,
todavia as vezes a internet está tão lenta que o programa
pára de responder e não resta outra saída além de apelar
para o Ctrl + Alt + Del, alguém conhece algum código
que possa contornar essa situação?
DS2T 19/02/2016 00:04:03
#457881
Resposta escolhida
Você precisa criar um loop e ir verificando a propriedade ReadyState do seu XmlHttp (Tá usando ele né?).
Se ela tiver ReadyState = 4 é sinal que já foi carregada, qualquer coisa você continua no loop.

Inclusive, a ideia que eu dou... é usar ele loop para implementar um TimeOut. Aí quando chegar no valor de TimeOut... ou chegar num certo número de iterações, você simplesmente corta o loop e fala que foi excedido o tempo/iteração limite.

Abraços!

JORGESALES 19/02/2016 20:48:35
#457948
Isso mesmo, estou usando o XmlHttp,
este é o código:
    Dim http As XMLHTTP
Dim xmlRetorno As DOMDocument
Dim Resultado As String
Set http = New XMLHTTP
http.Open [Ô]POST[Ô], [Ô]http://www.xmls.com.br/cnpj/busca.php?cnpj=[Ô] & CP & [Ô]&tipo=xml[Ô], False
http.setRequestHeader [Ô]Content-Type[Ô], [Ô]text/xml; charset=utf-8[Ô]
http.Send
DoEvents
Set xmlRetorno = http.responseXML
If (Not xmlRetorno Is Nothing) Then
txt45.Text = xmlRetorno.XML
Resultado = xmlRetorno.getElementsByTagName([Ô]Empresa//Resultado[Ô]).Item(0).Text
txt45.Text = xmlRetorno.getElementsByTagName([Ô]Empresa//RazaoSocial[Ô]).Item(0).Text
txt48.Text = xmlRetorno.getElementsByTagName([Ô]Empresa//Endereco[Ô]).Item(0).Text
Set obj = Nothing
End If

Como poderia adaptar o Loop?
DS2T 20/02/2016 17:50:06
#457962
Coloque o loop depois do DoEvents. Verifique a propriedade ReadyState do objeto xmlHttp como condicional do loop... Só libere do loop após o estado da requisição ficar como completa ou então, apos um certo limite de tempo/iterações.
Qualquer dúvida dá um toque.
JORGESALES 20/02/2016 18:21:45
#457964
Tentei assim mas não deu certo, fica um loop infinito:
    Do While http.ReadyState = 4
Set xmlRetorno = http.responseXML

If (Not xmlRetorno Is Nothing) Then
txt45.Text = xmlRetorno.XML
Resultado = xmlRetorno.getElementsByTagName([Ô]Empresa//Resultado[Ô]).Item(0).Text
txt45.Text = xmlRetorno.getElementsByTagName([Ô]Empresa//RazaoSocial[Ô]).Item(0).Text
txt48.Text = xmlRetorno.getElementsByTagName([Ô]Empresa//Endereco[Ô]).Item(0).Text
txt49.Text = xmlRetorno.getElementsByTagName([Ô]Empresa//Numero[Ô]).Item(0).Text
txt50.Text = xmlRetorno.getElementsByTagName([Ô]Empresa//Complemento[Ô]).Item(0).Text
txt51.Text = xmlRetorno.getElementsByTagName([Ô]Empresa//Bairro[Ô]).Item(0).Text
txt53.Text = xmlRetorno.getElementsByTagName([Ô]Empresa//Cidade[Ô]).Item(0).Text
txt54.Text = xmlRetorno.getElementsByTagName([Ô]Empresa//UF[Ô]).Item(0).Text
txt52.Text = xmlRetorno.getElementsByTagName([Ô]Empresa//CEP[Ô]).Item(0).Text
Set obj = Nothing
End If
Loop
LUIZCOMINO 21/02/2016 00:21:14
#457971
Tente assim amigão

  
Dim http As XMLHTTP
Dim xmlRetorno As DOMDocument
Dim Resultado As String
Set http = New XMLHTTP
http.Open [Ô]POST[Ô], [Ô]http://www.xmls.com.br/cnpj/busca.php?cnpj=[Ô] & CP & [Ô]&tipo=xml[Ô], False
http.setRequestHeader [Ô]Content-Type[Ô], [Ô]text/xml; charset=utf-8[Ô]
http.Send

Do While http.ReadyState <> 4
DoEvents
Loop

Set xmlRetorno = http.responseXML
If (Not xmlRetorno Is Nothing) Then
txt45.Text = xmlRetorno.XML
Resultado = xmlRetorno.getElementsByTagName([Ô]Empresa//Resultado[Ô]).Item(0).Text
txt45.Text = xmlRetorno.getElementsByTagName([Ô]Empresa//RazaoSocial[Ô]).Item(0).Text
txt48.Text = xmlRetorno.getElementsByTagName([Ô]Empresa//Endereco[Ô]).Item(0).Text
Set obj = Nothing
End If
JORGESALES 21/02/2016 19:24:39
#457999
Luiz,
Obrigado pela tentativa de ajuda, fiz o teste e acho que esse comando
não influencia em nada na função pois ele passa direto.
LUIZCOMINO 21/02/2016 19:45:46
#458001
Mude
Do While http.ReadyState <> 4
DoEvents
Loop

Para
While http.ReadyState <> 4
DoEvents
Wend
Tópico encerrado , respostas não são mais permitidas