HTTP requests for searching phone number on facebook and return search result to Excel



  • Hi all excel guru,
    I have a list of mobile number on column A.
    So far I just copy those number from excel and and paste it on search box on facebook just to check if the number was link to any facebook profile.
    If found then copy the name and profile link from facebook to excel.
    (Assume that the facebook is already log in)

    My Target is:
    By using excel macro perform copy - paste -facebook search -if found then copy the name and facebook profile to Excel.

    What I got so far on my searching(and did a little bit of modification) is

    [CODE]

    Sub XMLHTTP()

    Dim url As String, lastRow As Long
    Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
    Dim start_time As Date
    Dim end_time As Date
    
    '-----------check if internet connection is exist---------------
    If IsInternetConnected() = True Then
        ' connected
        MsgBox ("Internet is Connected")
    Else
        ' no connected
        MsgBox ("Internet is Not Connected")
    End If
    
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    Dim cookie As String
    Dim result_cookie As String
    
    start_time = Time
    Debug.Print "start_time:" & start_time
    
    For i = 2 To lastRow
    
        url = "https://www.google.co.in/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)
    
    
        Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
        XMLHTTP.Open "GET", url, False
        XMLHTTP.setRequestHeader "Content-Type", "text/xml"
        XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
        XMLHTTP.send
    
            Set html = CreateObject("htmlfile")
        html.body.innerHTML = XMLHTTP.ResponseText
        Set objResultDiv = html.getelementbyid("rso")
        On Error Resume Next
        Set objH3 = objResultDiv.getelementsbytagname("H3")(0)
        On Error Resume Next
        Set link = objH3.getelementsbytagname("a")(0)
    
    
        str_text = Replace(link.innerHTML, "<EM>", "")
        str_text = Replace(str_text, "</EM>", "")
    
        Cells(i, 2) = str_text
        Cells(i, 3) = link.href
        DoEvents
    Next
    
    end_time = Time
    Debug.Print "end_time:" & end_time
    
    Debug.Print "done" & "Time taken : " & DateDiff("n", start_time, end_time)
    MsgBox "done" & "Time taken : " & DateDiff("n", start_time, end_time)
    

    End Sub

    [/CODE]

    I try to modify the script above to fit my need by replacing link from google search to facebook search BUT still no luck yet

    [CODE]
    url = "https://www.google.co.in/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)

    REPLACE WITH

        url = "https://www.facebook.com/search/top/?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)
    

    [/CODE]

    Just for additional information about facebook search box HTML code is:

    [CODE]

    '<input type="text" class="_1frb" name="q" value="" autocomplete="off" placeholder="Find friends" role="combobox" aria-label="Search" aria-autocomplete="list" aria-expanded="true" aria-controls="typeahead_list_u_7_1">

    [/CODE]

    Thank you in advance for your help to solve my problem.

    Regards,
    Benny
    Benny


guest-login-reply
 

reconnecting-message