Facebook 公司名称未提取答案

【问题标题】：Facebook Business Name Not ExtractingFacebook 公司名称未提取
【发布时间】：2021-05-28 19:26:44
【问题描述】：

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

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

链接 = 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 和上面代码中所述的类，它提取了细节，这是一个旧的搜索结果。由于 IE 不再与 Fb 一起使用，我将其更改为上述内容，但使用了相同的类。只有这个类不起作用

在 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 建议无法删除此数据，因此我一直在尝试解决方法，即删除 outerHtml 并对其进行修剪。但是像往常一样，我被卡住了。

到目前为止，我已经这样做了，将类更改为获取 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)

我可以得到outerHtml，但是我不擅长修剪/剥离从A class=_2yau href="about:/cjwebdev/?ref=page_internal到cjwebdev的细节

任何帮助都可以 - 谢谢

【问题讨论】：

嗨，Sharid。如果 ID 始终相同，你应该得到你想要的 doc.getElementByID("u_0_0_OF").innerText
感谢 Zwenn，但这没有用
ID 和类名在不同的页面调用中会发生变化。我认为 ID entity_sidebar 是稳定的。试试ie.document.getElementByID("entity_sidebar").getElementsByTagName("a")(1).innerText 但是你用什么来加载HTML？ IE 中的调用更改为 Edge。
如果你看一下你通过 xhr 得到的 HTML，你会发现你想要的数据没有包含在内。我认为让它在页面上可见是 JS 的一部分。但是 JS 不适用于 xhr。使用 xhr，您只能获取静态内容，而不能获取动态内容。
在这种情况下，只有更少的 HTML。您可以在活动工作表的第一个单元格中使用Cells(1, 1) = doc.getElementByID("entity_sidebar").outerHTML 或在ide 的直接窗口中使用Debug.Print doc.getElementByID("entity_sidebar").outerHTML 使其可见。如果您需要更长的 HTML 部分，您可以将其保存到文本文件中。为了表明我必须写一个答案。但这是题外话。

标签： html excel vba web-scraping screen-scraping

【解决方案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 默认值。

【讨论】：

非常好。感谢您记得我查看head。还有一个带有属性content的元标记，可以从<meta property="og:title" content="BMW Park Lane">读取名称
@Zwenn 真的。谢谢你。我选择 HEAD 是为了确保它与本地企业名称明确关联。我没有看到足够多的网址来知道我是否做出了正确的决定¯_(ツ)_/¯
I haven't seen enough urls to know if I made the right decision ¯_(ツ)_/¯ 因为您的方法是 JSON 的一部分，所以我认为它是通用的。但为他的目的验证这一点是@Sharid 的任务。
非常感谢。当我检查没有找到[type='application/ld+json'] 的页面时，我感到很困惑。！！
@YasserKhalil 它在响应中。见regex101.com/r/tsugbe/2

【解决方案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

结果

【讨论】：