Facebook 企业名称未提取

Question

我正在努力从 Facebook 中提取企业名称。我可以很好地提取所有其他数据，只是不能提取公司名称。几天来我一直在尝试不同的变体，但无法解决。我试过添加 .Children (0) 也试过“标记” .getElementsByClassName("_64-f")(0).getElementsByTagName("Span")(0) 也用 child 标记 .getElementsByClassName("_64-f")(0).getElementsByTagName("Span")(0).children (0) 我也试过 Id 然后导航 child仁

如果代码如下所示，我不会收到任何错误，它只是在单元格中放置了一个连字符。对于其他变体，我收到错误消息 object variable or with block variable not set 或 object doesn't support this property or method

Link = Facebook Link

Q)正确的元素是什么?

    lastrows = .Cells(.Rows.Count, "A").End(xlUp).Row - .Cells(.Rows.Count, "B").End(xlUp).Row
    Sheet20.Range("B5").Value = lastrows - 1
  End With

    Counter = 0
    For Each link In varLinks
Application.ScreenUpdating = False
        DoEvents
        Set doc = NewHTMLDocument(CStr(link))
'''''Element 1 Column B
        If doc.getElementsByClassName("_64-f")(0) Is Nothing Then
            wsSheet.Cells(StartRow + myCounter, 2).Value = "-"
        Else
            wsSheet.Cells(StartRow + myCounter, 2).Value = doc.getElementsByClassName("_64-f")(0).innerText
        End If

<div class="fb_content clearfix " id="content">
  <div>
    <div class="clearfix">
      <div class="_1qkq _1qks">
        <div class="_lwx" style="position: relative; height: 762px;">
          <div class="_r_m _6ye8" role="navigation" aria-labelledby="u_0_0_OF" id="entity_sidebar" style="width: 180px; top: 0px; position: absolute;">
            <div id="u_0_d_UA">
              <div class="_6taw">
                <div class="_6taw">
                  <div class="_6tax">
                    <a aria-label="Profile picture" class="_2dgj" href="/225094634174032/photos/3538030452880417/" rel="theater">
                      <div class="_6tay" style="width: 172px; height: 172px;"><img class="_6tb5 img" src="https://scontent-lhr8-1.xx.fbcdn.net/v/t1.0-1/p320x320/92570293_3538030462880416_7204788388996579328_n.jpg?_nc_cat=107&amp;ccb=3&amp;_nc_sid=dbb9e7&amp;_nc_ohc=YoMPonz_koAAX-cvM6g&amp;_nc_ht=scontent-lhr8-1.xx&amp;tp=6&amp;oh=193586eb8fad5e292e7cc65ac6645668&amp;oe=605D4D63"
                          alt="" width="172" height="172"></div>
                    </a>
                  </div>
                </div>
              </div>
            </div>
            <div class="_19sz">
              <div class="_19s-">
                <div id="u_0_e_lO">
                  <div>
                    <div style=""><span><div id="u_0_0_OF">
                       <span class="_33vv">
                         <a class="_64-f" href="https://www.facebook.com/BMWParkLane/">
                          <span>BMW Park Lane</span></a>
                      </span><span class="_3d2h"></span></div>
                    </span>
                  </div>
                </div>
              </div>
            </div>
            <div class="_19s_">

我追求的形象

结果

'''' 今天更新 26/2/2021

IE 不再与 FB 一起使用，所以使用这个

Public Function NewHTMLDocument(strURL As String) As Object
''' Function For FB
    Dim objHTTP As Object, objHTML As Object, strTemp As String
    
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    objHTTP.setOption(2) = 13056
    On Error Resume Next
    objHTTP.Open "GET", strURL, False
    objHTTP.send
    On Error Resume Next
    If objHTTP.Status = 200 Then
        strTemp = objHTTP.responseText
        Set objHTML = CreateObject("htmlfile")
        objHTML.body.innerHTML = strTemp
        Set NewHTMLDocument = objHTML
    Else
        'There has been an error
    End If
End Function

''' ######## ###### 今天再次更新###############

最初我使用 IE 和上面代码中所述的 class，它提取了详细信息，这是一个旧的搜索结果。由于 IE 不再与 Fb 一起使用，我将其更改为上面的内容，但使用相同的 class。只有这个class不行

适用于 IE 的旧代码

   If doc.getElementsByClassName("_64-f")(0) Is Nothing Then
      wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = "-"
   Else
      dd = doc.getElementsByClassName("_64-f")(0).innerText
        Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = dd
   End If

'''' ########### 今天更新于 4:50 英国时间 #########

自从 Zwenn 告知不能取下此数据后，我一直在尝试解决方法，即取下外部 Html 并对其进行修整。但是像往常一样我被卡住了。

到目前为止我已经这样做了，将 class 更改为 outerHTML

'''''Element 1 Column B
       If doc.getElementsByClassName("_2yau")(0) Is Nothing Then
            wsSheet.Cells(StartRow + myCounter, 2).Value = "-"
        Else
            wsSheet.Cells(StartRow + myCounter, 2).Value = doc.getElementsByClassName("_2yau")(0).outerHTML
        End If

外Html

<A class=_2yau href="about:/cjwebdev/?ref=page_internal" data-endpoint="/cjwebdev/?ref=page_internal"><SPAN class=_2yav>Home</SPAN><SPAN role=progressbar aria-busy=true aria-valuetext=Loading... class="img _55ym _55yn _55yo _2wwb" aria-valuemin=0 aria-valuemax=100></SPAN></A>

然后我尝试去掉 /

之间的公司名称

Set wb = ThisWorkbook
Set wsSheet = wb.Sheets("Facebook")
     wsSheet.Columns(b).Value = Left(myString, InStr(2, myString, "/", vbTextCompare) - 1)

我可以得到外层Html，但是我不擅长triming/stripping从A class=_2yau href="about:/cjwebdev/?ref=page_internal到cjwebdev

的细节

任何帮助都行 - 谢谢

Answer 1

该值是从 HEAD 中的脚本标记动态提取的。我向你们展示如何：

使用 .responseText 中的正则表达式直接解析值
如何在传递到 HTMLDocument 变量的 body.innerHTML 时保留响应的 HEAD 内容，目标脚本标记所在的位置。使用保留的响应，我给 css 选择器以通过其 type 属性及其值匹配适当的脚本标记（不需要脚本类型选择器），以便提取可以解析的字符串一个 json 解析器来获得你想要的值。我没有显示 json 解析。

Option Explicit

Public Sub GetCompanyName()
    'tools > references > Microsoft HTML Object Library
    Dim re As Object, xhr As Object, html As MSHTML.HTMLDocument, s As String

    Set re = CreateObject("VBScript.RegExp")
    Set xhr = CreateObject("MSXML2.XMLHTTP")
    Set html = New MSHTML.HTMLDocument
    re.Pattern = """LocalBusiness"",""name"":""(.*?)"""
    
    With xhr
        .Open "GET", "https://www.facebook.com/pg/BMWParkLane/about/", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        s = .responseText
        html.body.innerHTML = "<body>" & s & "</html>" 'to preserve Head
        Debug.Print re.Execute(s)(0).SubMatches(0)
        Debug.Print html.querySelector("[type='application/ld+json']").innerHTML  'View the script tag
    End With

正则表达式：

与上述描述的不同之处在于我没有设置多行和全局标志，并保留了正则表达式对象的 VBA 默认值。

Answer 2

首先非常感谢 Zwenn 和 QHarr 抽出时间来提供帮助。一如既往，QHarr 从不让人失望，并且做了一些超出我能力范围的出色工作。 QHarr的方法是我接受的答案。

另一种方法是我的解决方法，即将 outerHTML 放入单元格中，然后 TRIM 将其放入单元格中，这样您只能看到结果

 Dim Cl As Range
        With Sheets("Facebook")
            For Each Cl In .Range("B2", .Range("B" & Rows.Count).End(xlUp))
                Cl.Value = Split(Cl.Value, "/")(1)
            Next Cl
         End With

结果

Facebook 企业名称未提取

Facebook Business Name Not Extracting

html

excel

vba

web-scraping

screen-scraping