Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
[RESOLVIDO]Copiar dados da internet com Vba
[RESOLVIDO]Copiar dados da internet com Vba
Boa tarde.
Sou novo no fórum e em Vba. Vi que o fórum é bastante rico em informações e participação de seus membros.
Pois bem...
Estou tentando construir um código que acesse uma página da web, com Caption, e copie os dados para uma planilha do excel.
O problema é que quando submeto a consulta, abre outra janela do navegador e eu não sei como interagir com esta nova janela para copiar os dados que necessito.
Segue código abaixo...
Private Sub CommandButton_CONSULTAR_Click()
'Determinando variáveis
Dim objIE As InternetExplorer
Dim elem
Dim tbl
Dim tr
'Abre navegador Internet Explorer
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.StatusBar = False
.Toolbar = False
.Width = 1000
.Height = 600
.Resizable = False
.AddressBar = False
.Visible = True
.Top = 200
.Left = 150
'Navega site e aguarda carregar completamente
.Navigate "http://smap14.mda.gov.br/extratopf/PesquisaTitular.aspx"
Do While .Busy Or _
.ReadyState <> 4
DoEvents
Loop
'Preenche cpf automaticamente
.Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtCPF").innertext = 'TextBox_CPF
'Coloca foco na caixa caption
reset:
.Document.getElementById("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Focus
x = .Document.activeElement.Name
Do While x = "ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode"
x = .Document.activeElement.Name
DoEvents
Loop
'Aguarda submissão do código
If .Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Value = "" Then GoTo reset
'Submete código
.Document.all("ctl00$ctl00$CONTENTEXTRATO$ContentPlaceHolder1$btnPesquisar").submit
Do While .Busy Or _
.ReadyState <> 4
DoEvents
Loop
'Após submeter, o navegador abre uma nova página e não consigo interagir com ela. Pode ser a cópia total da página que depois faço o tratamento necessário.
End With
End Sub
Sou novo no fórum e em Vba. Vi que o fórum é bastante rico em informações e participação de seus membros.
Pois bem...
Estou tentando construir um código que acesse uma página da web, com Caption, e copie os dados para uma planilha do excel.
O problema é que quando submeto a consulta, abre outra janela do navegador e eu não sei como interagir com esta nova janela para copiar os dados que necessito.
Segue código abaixo...
Private Sub CommandButton_CONSULTAR_Click()
'Determinando variáveis
Dim objIE As InternetExplorer
Dim elem
Dim tbl
Dim tr
'Abre navegador Internet Explorer
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.StatusBar = False
.Toolbar = False
.Width = 1000
.Height = 600
.Resizable = False
.AddressBar = False
.Visible = True
.Top = 200
.Left = 150
'Navega site e aguarda carregar completamente
.Navigate "http://smap14.mda.gov.br/extratopf/PesquisaTitular.aspx"
Do While .Busy Or _
.ReadyState <> 4
DoEvents
Loop
'Preenche cpf automaticamente
.Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtCPF").innertext = 'TextBox_CPF
'Coloca foco na caixa caption
reset:
.Document.getElementById("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Focus
x = .Document.activeElement.Name
Do While x = "ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode"
x = .Document.activeElement.Name
DoEvents
Loop
'Aguarda submissão do código
If .Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Value = "" Then GoTo reset
'Submete código
.Document.all("ctl00$ctl00$CONTENTEXTRATO$ContentPlaceHolder1$btnPesquisar").submit
Do While .Busy Or _
.ReadyState <> 4
DoEvents
Loop
'Após submeter, o navegador abre uma nova página e não consigo interagir com ela. Pode ser a cópia total da página que depois faço o tratamento necessário.
End With
End Sub
Editado pela última vez por absilva em Sex Jun 24, 2016 3:12 pm, em um total de 2 vezes.
- Mikel Silveira Fraga
- Jedi
- Mensagens: 1173
- Registrado em: Sex Mai 27, 2011 3:27 pm
- Localização: Governador Valadares - MG
- Contato:
Re: Copiar dados da internet com Vba
Absilva, boa tarde e seja bem vindo ao fórum.
Dei uma olhada em seu código e vi que realmente, ao selecionar o link Ver, é aberta uma nova janela com os dados.
Primeiro, vamos precisar realizar uma correção em algumas das últimas linhas do código, no momento de realizar a pesquisa. Altere as linhas abaixo:
Por:
Existe uma forma de interagir com essa nova janela, mas seria algo um pouco mais complicado e sem muita necessidade. Então, minha proposta abaixo, é exatamente pegar o link e realizar a navegação na própria janela que já esta instanciada pelo Objeto IE.
Para isso, adicione o código abaixo, acima do comando End With:
Faça as alterações e veja se vai funcionar do jeito que precisa.
Abraços.
Dei uma olhada em seu código e vi que realmente, ao selecionar o link Ver, é aberta uma nova janela com os dados.
Primeiro, vamos precisar realizar uma correção em algumas das últimas linhas do código, no momento de realizar a pesquisa. Altere as linhas abaixo:
Código: Selecionar todos
'Aguarda submissão do código
If .Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Value = "" Then GoTo reset
'Submete código
.Document.all("ctl00$ctl00$CONTENTEXTRATO$ContentPlaceHolder1$btnPesquisar").submit
Código: Selecionar todos
'Aguarda submissão do código
If VBA.Len(.Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Value) <> 5 Then GoTo reset
'Submete código
.Document.all("ctl00$ctl00$CONTENTEXTRATO$ContentPlaceHolder1$btnPesquisar").Click
Para isso, adicione o código abaixo, acima do comando End With:
Código: Selecionar todos
Set objElementCol = .Document.getElementsByTagName("a")
For Each objLink In objElementCol
If VBA.UCase(objLink.innerText) = VBA.UCase("Ver") Then
.Navigate objLink.href
Exit For
End If
Next objLink
Abraços.
Re: Copiar dados da internet com Vba
Nossa Professor, EXCELENTE!!!
Ficou perfeito o redirecionamento para o novo link. Mas ainda preciso de sua ajuda:
Quando abre o novo link, preciso copiar os dados e colar em uma planilha do excel para depois trata-los.
Logo após o comando objIE.Quit, estou tentando usar o .ExecWB 17, 0 para selecionar toda área. Após, pretendo usar o .ExecWB 12, 2 para copiar. Mas acho que o .ExecWB está buscando o objIE que fechamos, pois aparece "O Objeto chamado foi desconectado de seus clientes".
Pergunto: Como selecionar e copiar estes dados no total ou copiar um dados específico, como a validade?
Desde já, muito obrigado.
Ficou perfeito o redirecionamento para o novo link. Mas ainda preciso de sua ajuda:
Quando abre o novo link, preciso copiar os dados e colar em uma planilha do excel para depois trata-los.
Logo após o comando objIE.Quit, estou tentando usar o .ExecWB 17, 0 para selecionar toda área. Após, pretendo usar o .ExecWB 12, 2 para copiar. Mas acho que o .ExecWB está buscando o objIE que fechamos, pois aparece "O Objeto chamado foi desconectado de seus clientes".
Pergunto: Como selecionar e copiar estes dados no total ou copiar um dados específico, como a validade?
Desde já, muito obrigado.
- Mikel Silveira Fraga
- Jedi
- Mensagens: 1173
- Registrado em: Sex Mai 27, 2011 3:27 pm
- Localização: Governador Valadares - MG
- Contato:
Re: Copiar dados da internet com Vba
Absilva, boa tarde.
Que bom que funcionou do jeito que estava precisando.
Dando continuidade e pegando o sua sugestão, pode utilizar o código abaixo para capturar a data de validade da consulta. Lembrando que o código abaixo ainda deve ser inserido antes da linha de comando End With.
Nesse exemplo, estou apenas exibindo a data em uma Caixa de Text (MsgBox). Mas você irá definir o local onde vai querer armazenar essa informação.
Qualquer dúvidas, fico no aguardo.
Que bom que funcionou do jeito que estava precisando.
Dando continuidade e pegando o sua sugestão, pode utilizar o código abaixo para capturar a data de validade da consulta. Lembrando que o código abaixo ainda deve ser inserido antes da linha de comando End With.
Código: Selecionar todos
Do While .Busy Or _
.ReadyState <> 4
DoEvents
Loop
'Extrair a validade
Set objElementCol = .Document.getelementsbytagname("span")
For Each objText In objElementCol
If objText.Document.getelementsbytagname("strong").Length > 0 Then
If VBA.UCase(objText.innerText) Like VBA.UCase("Validade: *") Then
MsgBox VBA.Replace(objText.innerText, "Validade: ", "")
Exit For
End If
End If
Next objText
Qualquer dúvidas, fico no aguardo.
Re: Copiar dados da internet com Vba
Caro Professor, obrigado.
Mas creio que não fui muito claro. Perdão!
Na verdade não necessito que retorne a data da consulta, e sim a data de validade da DAP que consta no extrato.
Conforme suas orientações, fiz algumas adaptações e consegui colar os dados na planilha. Mas não sei se foi da forma mais correta. Segue o código revisado:
Sub Buscar_Dados()
Dim objIE As InternetExplorer
Dim elem
Dim tbl
Dim tr
Set objIE = CreateObject("InternetExplorer.Application") 'UserForm2.WebBrowser1
With objIE
.StatusBar = True
.Toolbar = True
.Width = 1000
.Height = 600
.Resizable = True
.AddressBar = True
.Visible = False
.Top = 150
.Left = 170
.Navigate "http://smap14.mda.gov.br/extratopf/PesquisaTitular.aspx"
Do While .Busy Or _
.ReadyState <> 4
DoEvents
Loop
.Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtCPF").innerText = "641.816.341-91" 'UserForm1("TextBox_CPF")
reset:
.Document.getElementById("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Focus
x = .Document.activeElement.Name
Do While x = "ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode"
x = .Document.activeElement.Name
DoEvents
Loop
.Visible = True
Unload UserForm1
'Aguarda submissão do código
If VBA.Len(.Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Value) <> 5 Then GoTo reset
.Visible = False
'Submete código
.Document.all("ctl00$ctl00$CONTENTEXTRATO$ContentPlaceHolder1$btnPesquisar").Click
Do While .Busy Or _
.ReadyState <> 4
DoEvents
Loop
Set objElementCol = .Document.getelementsbytagname("a")
For Each objLink In objElementCol
If VBA.UCase(objLink.innerText) = VBA.UCase("Ver") Then
.Navigate objLink.href
Exit For
End If
Next objLink
Do While .Busy Or _
.ReadyState <> 4
DoEvents
Loop
'Seleciona todos os dados e copia
.ExecWB 17, 0
.ExecWB 12, 2
'Ativa a Planilha, fecha o objIE e cola os dados
Windows("Consulta Extrato DAP.xlsm").Activate
Sheets("Plan2").Select
Range("A1").Select
objIE.Quit
Call Colar
Set objIE = Nothing
End With
End Sub
Aproveitando... Ficou muito bom o código Captcha aguardar 5 elementos para redirecionar. Mas quando digito o código errado, ainda assim ele conclui o procedimento e copia a página de consulta, quando deveria aguardar o código correto.
Ah... Perdão por não colocar o código dentro da caixa como o senhor faz, mas é que não sei como fazer.
Mais uma vez, obrigado!
Mas creio que não fui muito claro. Perdão!
Na verdade não necessito que retorne a data da consulta, e sim a data de validade da DAP que consta no extrato.
Conforme suas orientações, fiz algumas adaptações e consegui colar os dados na planilha. Mas não sei se foi da forma mais correta. Segue o código revisado:
Sub Buscar_Dados()
Dim objIE As InternetExplorer
Dim elem
Dim tbl
Dim tr
Set objIE = CreateObject("InternetExplorer.Application") 'UserForm2.WebBrowser1
With objIE
.StatusBar = True
.Toolbar = True
.Width = 1000
.Height = 600
.Resizable = True
.AddressBar = True
.Visible = False
.Top = 150
.Left = 170
.Navigate "http://smap14.mda.gov.br/extratopf/PesquisaTitular.aspx"
Do While .Busy Or _
.ReadyState <> 4
DoEvents
Loop
.Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtCPF").innerText = "641.816.341-91" 'UserForm1("TextBox_CPF")
reset:
.Document.getElementById("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Focus
x = .Document.activeElement.Name
Do While x = "ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode"
x = .Document.activeElement.Name
DoEvents
Loop
.Visible = True
Unload UserForm1
'Aguarda submissão do código
If VBA.Len(.Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Value) <> 5 Then GoTo reset
.Visible = False
'Submete código
.Document.all("ctl00$ctl00$CONTENTEXTRATO$ContentPlaceHolder1$btnPesquisar").Click
Do While .Busy Or _
.ReadyState <> 4
DoEvents
Loop
Set objElementCol = .Document.getelementsbytagname("a")
For Each objLink In objElementCol
If VBA.UCase(objLink.innerText) = VBA.UCase("Ver") Then
.Navigate objLink.href
Exit For
End If
Next objLink
Do While .Busy Or _
.ReadyState <> 4
DoEvents
Loop
'Seleciona todos os dados e copia
.ExecWB 17, 0
.ExecWB 12, 2
'Ativa a Planilha, fecha o objIE e cola os dados
Windows("Consulta Extrato DAP.xlsm").Activate
Sheets("Plan2").Select
Range("A1").Select
objIE.Quit
Call Colar
Set objIE = Nothing
End With
End Sub
Aproveitando... Ficou muito bom o código Captcha aguardar 5 elementos para redirecionar. Mas quando digito o código errado, ainda assim ele conclui o procedimento e copia a página de consulta, quando deveria aguardar o código correto.
Ah... Perdão por não colocar o código dentro da caixa como o senhor faz, mas é que não sei como fazer.
Mais uma vez, obrigado!
- Mikel Silveira Fraga
- Jedi
- Mensagens: 1173
- Registrado em: Sex Mai 27, 2011 3:27 pm
- Localização: Governador Valadares - MG
- Contato:
Re: Copiar dados da internet com Vba
Absilva, bom dia.
Cara, você chegou a desenvolver a rotina chamada "Colar"? Você não me enviou esta parte do código.
Sobre o uso da Método ExecWB do Internet Explorer, nunca utilizei e nem sei ao certo como o mesmo funciona.
Em minha última mensagem, quando montei a rotina que capturava a Data de Validade, meu intuito foi de montar um modelo (para ser adaptado) que atendesse a necessidade de extração dos dados, enviando a informação capturada diretamente para o local onde desejado. Acredito que seja o mais trabalhoso, mas com melhores resultados.
Tente adaptar o comando, seguindo a mesma lógica de raciocínio para os demais dados.
Ficamos no aguardo.
Cara, você chegou a desenvolver a rotina chamada "Colar"? Você não me enviou esta parte do código.
Sobre o uso da Método ExecWB do Internet Explorer, nunca utilizei e nem sei ao certo como o mesmo funciona.
Em minha última mensagem, quando montei a rotina que capturava a Data de Validade, meu intuito foi de montar um modelo (para ser adaptado) que atendesse a necessidade de extração dos dados, enviando a informação capturada diretamente para o local onde desejado. Acredito que seja o mais trabalhoso, mas com melhores resultados.
Tente adaptar o comando, seguindo a mesma lógica de raciocínio para os demais dados.
Ficamos no aguardo.
Re: Copiar dados da internet com Vba
Boa tarde professor
Segue abaixo a rotina que estou usando para colar.
Sub Colar()
'
' Colar Macro
Sheets("Plan2").Select
Range("A1").Select
ActiveSheet.PasteSpecial Format:="Texto", Link:=False, DisplayAsIcon:=False
Range("A1").Select
Sheets("Plan1").Select
Range("A6").Select
End Sub
Sobre o captcha, não consegui fazer parar a rotina quando o código é digitado errado:
If VBA.Len(.Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Value) <> 5 Then GoTo reset
Obrigado.
Segue abaixo a rotina que estou usando para colar.
Sub Colar()
'
' Colar Macro
Sheets("Plan2").Select
Range("A1").Select
ActiveSheet.PasteSpecial Format:="Texto", Link:=False, DisplayAsIcon:=False
Range("A1").Select
Sheets("Plan1").Select
Range("A6").Select
End Sub
Sobre o captcha, não consegui fazer parar a rotina quando o código é digitado errado:
If VBA.Len(.Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Value) <> 5 Then GoTo reset
Obrigado.
- Mikel Silveira Fraga
- Jedi
- Mensagens: 1173
- Registrado em: Sex Mai 27, 2011 3:27 pm
- Localização: Governador Valadares - MG
- Contato:
Re: Copiar dados da internet com Vba
Absilva, boa tarde.
Em relação ao erro do Captcha incorreto, reformulei a lógica para corrigir isso.
Aproveitei e dei uma reorganizada em seu código, para facilitar a leitura, conforme abaixo:
Sobre a função "Colar", nos testes que fiz funcionou perfeitamente. Talvez o problema fosse o fechamento mesmo do objIE.
Veja se agora vai funcionar do jeito que queria.
Em relação ao erro do Captcha incorreto, reformulei a lógica para corrigir isso.
Aproveitei e dei uma reorganizada em seu código, para facilitar a leitura, conforme abaixo:
Código: Selecionar todos
Sub Buscar_Dados()
Dim objIE As InternetExplorer
Set objIE = CreateObject("InternetExplorer.Application") 'UserForm2.WebBrowser1
With objIE
.StatusBar = True
.Toolbar = True
.Width = 1000
.Height = 600
.Resizable = True
.AddressBar = True
.Visible = False
.Top = 150
.Left = 170
.Navigate "http://smap14.mda.gov.br/extratopf/PesquisaTitular.aspx"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
.Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtCPF").innerText = "641.816.341-91" 'UserForm1("TextBox_CPF")
sbReset1:
'Unload UserForm1
.Visible = True
.Document.getElementById("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").innerText = ""
sbReset2:
.Document.getElementById("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Focus
x = .Document.activeElement.Name
Do While x = "ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode"
x = .Document.activeElement.Name
DoEvents
Loop
'Aguarda submissão do código
If VBA.Len(.Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Value) <> 5 Then GoTo sbReset2
.Visible = False
'Submete código
.Document.all("ctl00$ctl00$CONTENTEXTRATO$ContentPlaceHolder1$btnPesquisar").Click
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
Set objElementCol = .Document.getelementsbytagname("a")
For Each objLink In objElementCol
If VBA.UCase(objLink.innerText) = VBA.UCase("Ver") Then
.Navigate objLink.href
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
GoTo sbContinuar
End If
Next objLink
GoTo sbReset1
sbContinuar:
'Seleciona todos os dados e copia
.ExecWB 17, 0
.ExecWB 12, 2
'Ativa a Planilha, fecha o objIE e cola os dados
Windows("Consulta Extrato DAP.xlsm").Activate
Sheets("Plan2").Select
Range("A1").Select
.Quit
End With
Call Colar
Set objIE = Nothing
End Sub
Veja se agora vai funcionar do jeito que queria.
Re: Copiar dados da internet com Vba
Olá Professor.
Funcionou perfeitamente!
A página atualiza e gera novo código até que seja digitado corretamente.
- Mas quando há algum erro de digitação do CPF, aparece a seguinte mensagem: "Extrato não gerado – verificar inconsistência na DAP ou DAP não existe em nosso sistema". Gostaria que não travasse a rotina e redirecionasse para meu userform1 ("TextBox_CPF1").Select, ou poderia ser userform1 ("TextBox_CPF1").SetFocus para que seja digitado um CPF válido.
- Outra coisa:
Como este procedimento depende da qualidade da internet, às vezes dá a impressão de que ele travou, pois pode demorar muito. Estou vendo sobre como colocar uma barra de progresso. Mas o que encontrei diz respeito somente a inserção de dados na planilha ou em uma ListView. Neste caso deveria reportar somente o andamento das rotinas. Alguma sugestão?
Mais uma vez, obrigado pela disposição e paciência!
Segue abaixo todas as minhas rotinas:
Ao executar o CPF para consulta, segue para seguinte rotina:
Abaixo a rotina para colar os dados coletados:
Funcionou perfeitamente!
A página atualiza e gera novo código até que seja digitado corretamente.
- Mas quando há algum erro de digitação do CPF, aparece a seguinte mensagem: "Extrato não gerado – verificar inconsistência na DAP ou DAP não existe em nosso sistema". Gostaria que não travasse a rotina e redirecionasse para meu userform1 ("TextBox_CPF1").Select, ou poderia ser userform1 ("TextBox_CPF1").SetFocus para que seja digitado um CPF válido.
- Outra coisa:
Como este procedimento depende da qualidade da internet, às vezes dá a impressão de que ele travou, pois pode demorar muito. Estou vendo sobre como colocar uma barra de progresso. Mas o que encontrei diz respeito somente a inserção de dados na planilha ou em uma ListView. Neste caso deveria reportar somente o andamento das rotinas. Alguma sugestão?
Mais uma vez, obrigado pela disposição e paciência!
Segue abaixo todas as minhas rotinas:
Código: Selecionar todos
'Exibe a Userfom para inserção do CPF
Sub Consultar()
UserForm1.Show
End Sub
Código: Selecionar todos
Sub Buscar_Dados()
'Faz a busca pelo CPF digitado
'Evita a visualização das atualizações de página
Application.ScreenUpdating = True
Dim objIE As InternetExplorer
'Cria o IE
Set objIE = CreateObject("InternetExplorer.Application")
'Define o padrão do IE e o mantém oculto
With objIE
.StatusBar = False
.Toolbar = False
.Width = 1000
.Height = 600
.Resizable = False
.AddressBar = False
.Visible = False
.Top = 150
.Left = 170
'Navega na página e aguarda seu total carregamento
.Navigate "http://smap14.mda.gov.br/extratopf/PesquisaTitular.aspx"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
'Insere os números digitados na Userform1
.Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtCPF").innerText = UserForm1("TextBox_CPF1")
sbReset1:
'Exibe o objIE para que seja digitado o código Captcha
.Visible = True
'Apaga qualquer elemento que esteja no campo para ser digitado o código. Aguarda 5 dígitos e então submete. Caso o código seja incorreto, apaga o que foi digitado e aguarda 5 dígitos novamente
.Document.getElementById("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").innerText = ""
sbReset2:
'Coloca o insersor de texto na caixa do código
.Document.getElementById("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Focus
x = .Document.activeElement.Name
Do While x = "ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode"
x = .Document.activeElement.Name
DoEvents
Loop
'Aguarda submissão do código
If VBA.Len(.Document.all.Item("ctl00_ctl00_CONTENTEXTRATO_ContentPlaceHolder1_txtUserCode").Value) <> 5 Then GoTo sbReset2
'Oculta objIE
.Visible = False
'Submete código
.Document.all("ctl00$ctl00$CONTENTEXTRATO$ContentPlaceHolder1$btnPesquisar").Click
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
'Caso o código Captcha esteja correto, aguarda carregar e abre o link do extrato na mesma página
Set objElementCol = .Document.getelementsbytagname("a")
For Each objLink In objElementCol
If VBA.UCase(objLink.innerText) = VBA.UCase("Ver") Then
.Navigate objLink.href
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
GoTo sbContinuar
End If
Next objLink
GoTo sbReset1
sbContinuar:
'Seleciona todos os dados e copia
.ExecWB 17, 0
.ExecWB 12, 2
'Ativa a Planilha, fecha o objIE e cola os dados
Windows("Consulta Extrato DAP - Cópia de Segurança.xlsm").Activate
.Quit
Set objIE = Nothing
End With
Call Colar
'Deixa as atualizações visíveis novamente
Application.ScreenUpdating = True
End Sub
Código: Selecionar todos
Sub Colar()
'O código abaixo deveria ser usado caso o excel não ficasse em foco. O que não é o caso
'Windows("Consulta Extrato DAP - Cópia de Segurança.xlsm").Activate
Sheets("Plan2").Select
Range("A1").Select
'Cola somente texto
ActiveSheet.PasteSpecial Format:="Texto", Link:=False, DisplayAsIcon:=False
'Coloca a Planilha BancoDados em foco. É onde os dados, depois de tratados, serão gravados.
Sheets("BancoDados").Select
Range("A6").Select
End Sub
- Mikel Silveira Fraga
- Jedi
- Mensagens: 1173
- Registrado em: Sex Mai 27, 2011 3:27 pm
- Localização: Governador Valadares - MG
- Contato:
Re: Copiar dados da internet com Vba
Absilva, boa tarde.
Como tem passado, tudo bem? Espero que sim.
Então, como não tenho o modelo completo para testar o comportamento entre a Janela do Navegador e o Userform do Excel, pensei em encerrar a execução do Navegador ao detectar o Erro do Extrato DAP. Dessa forma, o Userform será exibido em 1º plano na tela.
O código abaixo, deve ser adicionado entre os comandos Next objLink e GoTo sbReset1:
Teste e veja se atende dessa forma.
Sobre a barra de progresso, não sei se vai conseguir fazer o que deseja, não de forma eficiente.
Quando se trabalha com uma ProgressBar, a ideia é ver o evolutivo das etapas de um processo, sendo que cada comando executado, pode ser considerado uma etapa. No caso da lentidão da internet, você esta tendo a demora de um retorno de uma única etapa e não de várias etapas que compõem um processo. Nesse caso, a ideia de exibir a continuidade de um processo, vai ficar parado do mesmo jeito, não exibindo a sua evolução.
Não sei se fui claro sobre isso. Qualquer outra dúvida, estamos a disposição.
Abraços.
Como tem passado, tudo bem? Espero que sim.
Então, como não tenho o modelo completo para testar o comportamento entre a Janela do Navegador e o Userform do Excel, pensei em encerrar a execução do Navegador ao detectar o Erro do Extrato DAP. Dessa forma, o Userform será exibido em 1º plano na tela.
O código abaixo, deve ser adicionado entre os comandos Next objLink e GoTo sbReset1:
Código: Selecionar todos
'Valida o resultado da pesquisa.
Do While .Busy Or .readyState <> 4: DoEvents: Loop 'Aguarda carregamento erro.
Const strErrorExtrato As String = _
"Extrato não gerado – verificar inconsistência na DAP ou DAP não existe em nosso sistema"
Set objElementCol = .document.getElementsByTagName("li")
For Each objError In objElementCol
If VBA.UCase(objError.innerText) = VBA.UCase(strErrorExtrato) Then
MsgBox strErrorExtrato, vbCritical, "Erro DAP"
.Quit
Exit Sub
End If
Next objError
Sobre a barra de progresso, não sei se vai conseguir fazer o que deseja, não de forma eficiente.
Quando se trabalha com uma ProgressBar, a ideia é ver o evolutivo das etapas de um processo, sendo que cada comando executado, pode ser considerado uma etapa. No caso da lentidão da internet, você esta tendo a demora de um retorno de uma única etapa e não de várias etapas que compõem um processo. Nesse caso, a ideia de exibir a continuidade de um processo, vai ficar parado do mesmo jeito, não exibindo a sua evolução.
Não sei se fui claro sobre isso. Qualquer outra dúvida, estamos a disposição.
Abraços.