Autor Tema: AYUDA CON EXTRAER EMIAL  (Leído 2230 veces)

0 Usuarios y 1 Visitante están viendo este tema.

..::Carlos::..

  • Bytes
  • *
  • Mensajes: 44
  • Reputación: +0/-0
    • Ver Perfil
AYUDA CON EXTRAER EMIAL
« en: Agosto 07, 2011, 02:31:43 pm »
mi pregunta es que como puedo hacer para extraer los emails de una web por ejemplo
extraer todos los email que me aparecen en ese resultado
http://www.google.com.co/search?q=%40"hotmail.com"%20"cuba"%20"ana"&num=100"

gracias y les agradesco mucho de antemano a este foro
muy agradecido con el foro  ;) :D

LeandroA

  • Administrador
  • Petabyte
  • *****
  • Mensajes: 1128
  • Reputación: +151/-8
    • Ver Perfil
Re:AYUDA CON EXTRAER EMIAL
« Respuesta #1 en: Agosto 09, 2011, 01:09:52 am »
Hola carlos fijate con este código, se puede mejorar un poco mas las expresiones regulares pero bueno queda en tus manos


Agrega un CommandButton,un ListBox y un Text1
Código: [Seleccionar]

Option Explicit

Function ExtraerEmail(ByVal sURL As String) As Boolean
    On Error GoTo ErrFuntion
    Dim obj_Expresion As Object, Match, Matches
    Dim HtmlDOC As Object
    Dim sHtml As String
    Dim oXMLHTTP As Object
   
    Set oXMLHTTP = CreateObject("Microsoft.XMLHTTP")
   
    oXMLHTTP.Open "GET", Text1.Text, False
   
    oXMLHTTP.Send

    Set HtmlDOC = CreateObject("htmlfile_FullWindowEmbed")
   
    HtmlDOC.body.innerHTML = oXMLHTTP.responseText

 
    Set obj_Expresion = CreateObject("vbscript.regexp")

    obj_Expresion.Pattern = "[^,;\s]+@[^,;\s]+"
    obj_Expresion.IgnoreCase = True
    obj_Expresion.Global = True
     
    Set Matches = obj_Expresion.Execute(HtmlDOC.body.innerText)
     
    For Each Match In Matches
        List1.AddItem Match.Value
    Next
   
    ExtraerEmail = True

    Exit Function

   
ErrFuntion:
   
End Function

Private Sub Command1_Click()
    Call ExtraerEmail(Text1)
End Sub

..::Carlos::..

  • Bytes
  • *
  • Mensajes: 44
  • Reputación: +0/-0
    • Ver Perfil
Re:AYUDA CON EXTRAER EMIAL
« Respuesta #2 en: Agosto 31, 2011, 11:17:33 am »
Hola brother acabo de ver el code esta buenazo eres un bacan
Gracias   ;)