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

Consultar e copiar dados [RESOLVIDO]

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.
Avatar do usuário
Mikel Silveira Fraga
Jedi
Jedi
Mensagens: 1173
Registrado em: Sex Mai 27, 2011 3:27 pm
Localização: Governador Valadares - MG
Contato:

Re: Consultar e copiar dados

Mensagem por Mikel Silveira Fraga »

Wagner, bom dia.

Neste caso, a lógica já é um pouco diferente. Como havia dito, cada estrutura é única.

Bem, não testei o código, mas alterei conforme situação apresentada:

Código: Selecionar todos

Sub CaptureCountry()

Dim ie As Object
Dim iLin, iCount As Long

'instancia de objeto do IE e o torna visível
Set ie = CreateObject("internetexplorer.application")
ie.Visible = True

'Inicia o processo de varredura da lista.
For iLin = 2 To Plan1.UsedRange.Rows.Count
   
   'Verifica se existe algum NLM informado
   'na linha atual da coluna A da planilha.
   'Caso encontre, a rotina irá interromper o laço.
   If Plan1.Cells(iLin, 1).Value = "" Then Exit For
   
   'Carrega a página atual, utilizando o endereço da coluna C.
   ie.Navigate Plan1.Cells(iLin, 3).Value

   'Aguarda carregamento da página.
   Do While ie.Busy: VBA.DoEvents: Loop
      
   'Verifica se houve algum resultado da pesquisa.
   'Caso não haja, irá para a próxima linha.
   If ie.Document.getElementsByTagName("li").Length <= 0 Then GoTo nextLinha
   
   For iCount = 0 To ie.Document.getElementsByTagName("li").Length - 1
    If ie.Document.getElementsByTagName("li")(iCount).innerText Like "País*" Then
      'Captura o país da NLM e envia para  a planilha.
      Plan1.Cells(iLin, 2).Value = VBA.Trim(VBA.Replace( _
        ie.Document.getElementsByTagName("li")(iCount).innertext, "País", ""))
       GoTo nextLinha 'Força saída do laço.
    End If
   Next iCount
   
   'Caso não encontre nada no teste acima,
   'redireciona a rotina para a próxima linha.
   GoTo nextLinha

nextLinha: 'Referência pra próxima linha.
   
Next iLin

'Limpa o objeto ie
Set ie = Nothing

End Sub
Teste e veja se agora finalizamos essa rotina.

Abraços!!!


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.


Wagner.cwb
Manda bem
Manda bem
Mensagens: 168
Registrado em: Sáb Set 24, 2016 4:48 pm

Re: Consultar e copiar dados

Mensagem por Wagner.cwb »

Fantástico, muito obrigado!
Gostei muito de aprender com vocês. desculpe-me pelo trabalho :D

I’ll Be Back :lol:

Abraços.


Wagner.cwb
Manda bem
Manda bem
Mensagens: 168
Registrado em: Sáb Set 24, 2016 4:48 pm

Re: Consultar e copiar dados [RESOLVIDO]

Mensagem por Wagner.cwb »

É meus Caros, eu voltei rs

Bom, enrosquei na última etapa.
Agora estou buscando capturar dados de dentro de uma tabela, só que a adaptação esta pegando apenas a primeira linha.

Preciso coletar os dados "Base de datos" - exemplo http://www.dondelopublico.com/ficha/0004-0592

Código: Selecionar todos

<th scope="col" align="center" class="">Base de datos</th>
    </tr>
    		<tr>
    	<td>0004-0592</td>
      <td>s/d</td>
    	<td><a href="http://www.latindex.unam.mx/latindex/bAvanzada
" target="_blank" data-toggle="popover" title="Latindex Catálogo" data-html="true" data-placement="right" data-content="Publicado por la UNAM, el Catálogo Latindex contiene más de 6000 revistas científicas de Iberoamérica que cumplen criterios de calidad editorial.  <br><br>Fecha de actualización: 2016-05-25" data-trigger="hover"> Latindex Catálogo</a></td>
        </tr>
        		<tr>
    	<td>0004-0592</td>
      <td>s/d</td>
    	<td><a href="http://scielo.isciii.es/scielo.php?script=sci_serial&pid=0004-0592&lng=es&nrm=iso
" target="_blank" data-toggle="popover" title="SciELO" data-html="true" data-placement="right" data-content="Scientific Electronic Library Online es una biblioteca electrónica que conforma una red iberoamericana de colecciones de revistas científicas en texto completo y con acceso abierto, libre y gratuito.  El modelo recupera la ciencia de los países en desarrollo y otorga la visibilidad que la corriente principal no ofrece a la comunicación científica de la región. Como instrumento de evaluación el sitio proporciona indicadores estadísticos de uso y factor de impacto de las revistas.  <br><br>Fecha de actualización: 2015-03-13" data-trigger="hover"> SciELO</a></td>
        </tr>
        		<tr>
    	<td>0004-0592</td>
      <td>s/d</td>
    	<td><a href="https://www.elsevier.com/__data/assets/excel_doc/0015/91122/title_list.xlsx" target="_blank" data-toggle="popover" title="Scopus" data-html="true" data-placement="right" data-content="Scopus es la base de datos de citas elaborada por Elsevier y principal alternativa a los productos ISI-Thomson Reuters. Cubre aproximadamente 18.000 títulos de más de 5.000 editores internacionales, incluyendo la cobertura de 16.500 revistas revisadas por pares de las áreas de ciencias, tecnología, medicina y ciencias sociales, incluyendo artes y humanidades. <br><br>Fecha de actualización: 2016-05-28" data-trigger="hover"> Scopus</a></td>
        </tr>
        		<tr>
    	<td>0004-0592</td>
      <td>s/d</td>
    	<td><a href="http://www.redalyc.org/revista.oa?id=495
" target="_blank" data-toggle="popover" title="REDALyC" data-html="true" data-placement="right" data-content="redalyc.org es una iniciativa de acceso abierto a la producción científica publicada en revistas iberoamericanas, que contempla todas las áreas del conocimiento. Cubre actualmente más de 1000 revistas que han pasado por una evaluación exhaustiva de calidad editorial. Es desarrollada por la Universidad Autónoma del Estado de México desde 2003. <br><br>Fecha de actualización: 2016-06-06" data-trigger="hover"> REDALyC</a></td>
        </tr>
        		<tr>
    	<td>0004-0592</td>
      <td>s/d</td>
    	<td><a href="http://evaluacionarce.fecyt.es/documentos/ListadoSelloFECYT.pdf
" target="_blank" data-toggle="popover" title="Sello FECyT" data-html="true" data-placement="right" data-content=" <br><br>Fecha de actualización: 2016-06-01" data-trigger="hover"> Sello FECyT</a></td>
        </tr>
        		<tr>
    	<td>1885-4494</td>
      <td>s/d</td>
    	<td><a href="http://www.latindex.unam.mx/latindex/bAvanzada
" target="_blank" data-toggle="popover" title="Latindex Catálogo" data-html="true" data-placement="right" data-content="Publicado por la UNAM, el Catálogo Latindex contiene más de 6000 revistas científicas de Iberoamérica que cumplen criterios de calidad editorial.  <br><br>Fecha de actualización: 2016-05-25" data-trigger="hover"> Latindex Catálogo</a></td>
        </tr>
        		<tr>
    	<td>1885-4494</td>
      <td>s/d</td>
    	<td><a href="http://www.redalyc.org/revista.oa?id=495
" target="_blank" data-toggle="popover" title="REDALyC" data-html="true" data-placement="right" data-content="redalyc.org es una iniciativa de acceso abierto a la producción científica publicada en revistas iberoamericanas, que contempla todas las áreas del conocimiento. Cubre actualmente más de 1000 revistas que han pasado por una evaluación exhaustiva de calidad editorial. Es desarrollada por la Universidad Autónoma del Estado de México desde 2003. <br><br>Fecha de actualización: 2016-06-06" data-trigger="hover"> REDALyC</a></td>
        </tr>
        		<tr>
    	<td>1885-4494</td>
      <td>s/d</td>
    	<td><a href="http://evaluacionarce.fecyt.es/documentos/ListadoSelloFECYT.pdf
" target="_blank" data-toggle="popover" title="Sello FECyT" data-html="true" data-placement="right" data-content=" <br><br>Fecha de actualización: 2016-06-01" data-trigger="hover"> Sello FECyT</a></td>
        </tr>
        	</tbody></table>

Código: Selecionar todos

Sub Capturebase()

Dim ie As Object
Dim iLin, iCount As Long

'instancia de objeto do IE e o torna visível
Set ie = CreateObject("internetexplorer.application")
ie.Visible = True

'Inicia o processo de varredura da lista.
For iLin = 2 To Plan1.UsedRange.Rows.Count
   
   'Verifica se existe algum NLM informado
   'na linha atual da coluna A da planilha.
   'Caso encontre, a rotina irá interromper o laço.
   If Plan1.Cells(iLin, 1).Value = "" Then Exit For
   
  'Carrega a página atual, utilizando o endereço da coluna C.
   ie.navigate Plan1.Cells(iLin, 3).Value

   'Aguarda carregamento da página.
   Do While ie.busy: VBA.DoEvents: Loop
     
   'Verifica se houve algum resultado da pesquisa.
   'Caso não haja, irá para a próxima linha.
   If ie.document.getelementsbytagname("th").Length <= 0 Then GoTo nextLinha
   
   For iCount = 0 To ie.document.getelementsbytagname("th").Length - 1
    If ie.document.getelementsbytagname("th")(iCount).innertext Like "Base de datos*" Then GoTo Continue
   Next iCount
   
   'Caso não encontre nada no teste acima,
   'redireciona a rotina para a próxima linha.
   GoTo nextLinha

Continue: 'Referência de continuação da captura do país.
   
   'Captura o país da NLM e envia para  a planilha.
   Plan1.Cells(iLin, 10).Value = ie.document.getelementsbytagname("tr")(iCount).innertext

nextLinha: 'Referência pra próxima linha.
   
Next iLin

'Limpa o objeto ie
Set ie = Nothing

End Sub
Por favor, solicito mais uma ajuda, obrigado!


Avatar do usuário
Mikel Silveira Fraga
Jedi
Jedi
Mensagens: 1173
Registrado em: Sex Mai 27, 2011 3:27 pm
Localização: Governador Valadares - MG
Contato:

Re: Consultar e copiar dados

Mensagem por Mikel Silveira Fraga »

Wagner, boa noite.

Como já havíamos concluído o assunto, o ideal seria abrir um novo tópico para este novo problema.

Dúvidas, estamos a disposição.

Abraços e bom final de semana.


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.


Wagner.cwb
Manda bem
Manda bem
Mensagens: 168
Registrado em: Sáb Set 24, 2016 4:48 pm

Re: Consultar e copiar dados

Mensagem por Wagner.cwb »

Ok, compreendi, sem problemas,

abraço!


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