Foxtable(狐表)用户栏目专家坐堂 → 求助:今日头条解析到数据表,结果运行出错,求解!


  共有2770人关注过本帖树形打印复制链接

主题:求助:今日头条解析到数据表,结果运行出错,求解!

帅哥哟,离线,有人找我吗?
李孝春
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2472 积分:17346 威望:0 精华:0 注册:2013/1/31 0:03:00
求助:今日头条解析到数据表,结果运行出错,求解!  发帖心情 Post By:2016/11/1 10:41:00 [显示全部帖子]

运行错误如下:

图片点击可在新窗口打开查看此主题相关图片如下:11.png
图片点击可在新窗口打开查看
项目实例如下:
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:今日头条.table
按钮代码如下:
Dim web As new System.Windows.Forms.WebBrowser
web.ScriptErrorsSuppressed = True
'web.Navigate("http://toutiao.com/m6114233861/")
Dim ad As WinForm.ComboBox = e.Form.Controls("ComboBox2")
web.Navigate(ad.Value)
Do Until web.ReadyState = 4
    Application.DoEvents
Loop
Dim pg = web.Document.GetElementById("pagebar").GetElementsByTagName("a")
Dim mpg As Integer = 1
If pg.count > 1 Then
    mpg = pg(pg.count-2).Innertext
End If
DataTables("文章列表").DataRows.Clear
For i As Integer = 1 To mpg
    web.Navigate( ad.text & "/p" & i)
    'web.Navigate("http://toutiao.com/m6114233861/p" & i)
    Do Until web.ReadyState = 4
        Application.DoEvents
    Loop
    Dim divs = web.Document.GetElementById("ColumnContainer")
    For Each div As object In divs.GetElementsByTagName("div")
        If div.GetAttribute("ClassName") = "pin" Then
            Dim tbs = div.GetElementsByTagName("table")
            Dim trs = tbs(0).GetElementsByTagName("tr")
            'output.show(trs(0).GetElementsByTagName("h3")(0).Innertext) '文章标题
            'output.show(trs(0).GetElementsByTagName("a")(0).GetAttribute("href")) '文章标题
            'output.show(trs(1).GetElementsByTagName("div")(1).Innertext)  '正文
            Dim tds = trs(2).GetElementsByTagName("td")
            'output.show(tds(1).innertext)  '阅读数
            'output.show(tds(2).innertext)  '评论数
            'output.show(tds(3).innertext)  '发布时间
            'output.show("------")
            Dim dr As DataRow = DataTables("文章列表").AddNew()
            Dim 阅读数 As String = tds(1).innertext
            Dim Parts() As String = 阅读数.Split(":")
            Dim 评论数 As String = tds(2).innertext
            Dim Parts1() As String = 评论数.Split(":")
            Dim bt As System.Windows.Forms.HtmlElement
            bt = web.Document.GetElementByID("keywords")   '今日头条单位标题
            'Output.Show(bt.innerText & " " & bt.GetAttribute("content"))
            dr("单位") = bt.innerText & " " & bt.GetAttribute("content")
            'msgbox(bt.innerText & " " & bt.GetAttribute("content"))
            dr("文章标题") = trs(0).GetElementsByTagName("h3")(0).Innertext
            dr("发布时间") = tds(3).innertext
            dr("阅读数") = Parts(1)
            dr("评论数") = Parts1(1)
            dr("正文") = trs(1).GetElementsByTagName("div")(1).Innertext
            dr("网址") = trs(0).GetElementsByTagName("a")(0).GetAttribute("href")
        End If
    Next
Next
[此贴子已经被作者于2016/11/1 10:41:52编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
李孝春
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2472 积分:17346 威望:0 精华:0 注册:2013/1/31 0:03:00
回复:(有点蓝)所有使用GetElementById、GetElement...  发帖心情 Post By:2016/11/1 11:46:00 [显示全部帖子]

不抱错  但是也没数据 
Dim web As new System.Windows.Forms.WebBrowser
web.ScriptErrorsSuppressed = True
web.Navigate("http://toutiao.com/m6114233861/")

Do Until web.ReadyState = 4
    Application.DoEvents
Loop

Dim e1  = web.Document.GetElementById("pagebar")
If e1 IsNot Nothing Then
    
    Dim pg = e1.GetElementsByTagName("a")
    
    If pg.count > 0 Then
        Dim mpg As Integer = 1
        If pg.count > 1 Then
            mpg = pg(pg.count-2).Innertext
        End If    
        For i As Integer = 1 To mpg
            web.Navigate("http://toutiao.com/m6114233861/p" & i)
            Do Until web.ReadyState = 4
                Application.DoEvents
            Loop
            Dim divs = web.Document.GetElementById("ColumnContainer")
            For Each div As object In divs.GetElementsByTagName("div")
                If div.GetAttribute("ClassName") = "pin" Then
                    Dim tbs = div.GetElementsByTagName("table")
                    Dim trs = tbs(0).GetElementsByTagName("tr")
                    output.show(trs(0).GetElementsByTagName("h3")(0).Innertext) '文章标题
                    output.show(trs(0).GetElementsByTagName("a")(0).GetAttribute("href")) '文章标题
                    output.show(trs(1).GetElementsByTagName("div")(1).Innertext)  '正文
                    Dim tds = trs(2).GetElementsByTagName("td")
                    output.show(tds(1).innertext)  '阅读数
                    output.show(tds(2).innertext)  '评论数
                    output.show(tds(3).innertext)  '发布时间
                    output.show("------")
                   
                End If
            Next
        Next
        
    End If
End If

 回到顶部
帅哥哟,离线,有人找我吗?
李孝春
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2472 积分:17346 威望:0 精华:0 注册:2013/1/31 0:03:00
回复:(有点蓝)说明页面没有对应的标签,请求出错或...  发帖心情 Post By:2016/11/1 13:30:00 [显示全部帖子]

Dim web As new windows.forms.webbrowser
web.Navigate("http://toutiao.com/m6051259851/")
Do Until web.ReadyState = 4
    Application.DoEvents
Loop
Dim getReader = new System.IO.StreamReader(web.DocumentStream, Encoding.Default)
Dim str = getReader.ReadToEnd()
'output.show(str)

Dim bt As System.Windows.Forms.HtmlElement
bt = web.Document.GetElementByID("keywords")   '今日头条单位标题
Dim bt1 As System.Windows.Forms.HtmlElement
bt1 = web.Document.GetElementByID("description")
Output.Show(bt.innerText & " " & bt.GetAttribute("content"))   ‘输出结果:瓮安县人民检察院
Output.Show(bt1.innerText & " " & bt1.GetAttribute("content")) ‘输出结果: 瓮安县人民检察院头条号,带您了解详尽的行业资讯.瓮安县人民检察院深度分析,专业见解.你关心的,才是头条.阅读瓮安县人民检察院最新文章,就在头条号.

Dim divs = web.Document.GetElementById("media-header")
For Each div As object In divs.GetElementsByTagName("div")
    If div.GetAttribute("Class") = "rbox-inner" Then
        Dim tbs = div.GetElementsByTagName("title-box link")
        Dim trs = tbs(0).GetElementsByTagName("title-box link")
        output.show(tbs(0).GetElementsByTagName("href")(0).Innertext) '
        output.show(trs(1).GetElementsByTagName("abstract")(1).Innertext)  '
        
    End If
Next



下面是输出结果:
 瓮安县人民检察院
 瓮安县人民检察院头条号,带您了解详尽的行业资讯.瓮安县人民检察院深度分析,专业见解.你关心的,才是头条.阅读瓮安县人民检察院最新文章,就在头条号.

更多的文章标题  地址 阅读数  评论数 发布时间  文章简介却操作不出来


 回到顶部
帅哥哟,离线,有人找我吗?
李孝春
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2472 积分:17346 威望:0 精华:0 注册:2013/1/31 0:03:00
回复:(有点青) 你可以用手动的方式。放一个we...  发帖心情 Post By:2016/11/1 13:46:00 [显示全部帖子]

有没有办法直接获取指定行数的数据呢?
比如每次加载十行  那么我指定每次加载的行数 或者按照之前的页数方式 加载全部页数 加载全部行数来操作呢?


 回到顶部
帅哥哟,离线,有人找我吗?
李孝春
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2472 积分:17346 威望:0 精华:0 注册:2013/1/31 0:03:00
回复:(有点青) 你可以用手动的方式。放一个we...  发帖心情 Post By:2016/11/1 14:01:00 [显示全部帖子]

参照写,报错如下:
Dim web As new System.Windows.Forms.WebBrowser
web.ScriptErrorsSuppressed = True
web.Navigate("http://toutiao.com/m6051259851/")
Do Until web.ReadyState = 4 AndAlso web.Document.GetElementById("content-left") IsNot Nothing AndAlso web.Document.GetElementById("content-left").GetElementsByTagName("li").count > 0
    Application.DoEvents
Loop
Dim lis = web.Document.GetElementById("content-left").GetElementsByTagName("li")
For i As Integer = 0 To lis.count-1
Dim lsa = lis(i).GetElementsByTagName("a")
output.show(lsa(0).InnerHtml)
Dim lsp = lis(i).GetElementsByTagName("p")
output.show(lsp(1).InnerHtml)
Dim lspSPAN = lis(i).GetElementsByTagName("SPAN")
output.show(lspSPAN(2).InnerHtml)
Dim lsphref = lis(i).GetElementsByTagName("href")
output.show(lsphref(0).InnerHtml)
Next

图片点击可在新窗口打开查看此主题相关图片如下:111.png
图片点击可在新窗口打开查看


 回到顶部
帅哥哟,离线,有人找我吗?
李孝春
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2472 积分:17346 威望:0 精华:0 注册:2013/1/31 0:03:00
回复:(有点青)你这种方法无效了,人家用动态加载了...  发帖心情 Post By:2016/11/1 14:11:00 [显示全部帖子]

如果需要加载A标签下  class="title-box link" 这个的值 怎么代码中加上呢?

Dim web As new System.Windows.Forms.WebBrowser
web.ScriptErrorsSuppressed = True
web.Navigate("http://toutiao.com/m6114233861/")

Do Until web.ReadyState = 4 AndAlso web.Document.GetElementById("content-left") IsNot Nothing AndAlso web.Document.GetElementById("content-left").GetElementsByTagName("li").count > 0
    Application.DoEvents
Loop
Dim lis = web.Document.GetElementById("content-left").GetElementsByTagName("li")
DataTables("文章列表").DataRows.Clear
For i As Integer = 0 To lis.count-1
    Dim lsa = lis(i).GetElementsByTagName("a")
    output.show(lsa(0).InnerHtml)
Next


 回到顶部
帅哥哟,离线,有人找我吗?
李孝春
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2472 积分:17346 威望:0 精华:0 注册:2013/1/31 0:03:00
回复:(有点青)不可以指定行数或者页数。方法看6楼。...  发帖心情 Post By:2016/11/1 14:58:00 [显示全部帖子]

我仿照写法 准备查找下当前文章的摘要abstract
Dim web As new System.Windows.Forms.WebBrowser
web.ScriptErrorsSuppressed = True
web.Navigate("http://toutiao.com/m6114233861/")
Do Until web.ReadyState = 4 AndAlso web.Document.GetElementById("content-left") IsNot Nothing AndAlso web.Document.GetElementById("content-left").GetElementsByTagName("li").count > 0
    Application.DoEvents
Loop
Dim lis = web.Document.GetElementById("content-left").GetElementsByTagName("li")
For i As Integer = 0 To lis.count-1
    Dim lsa = lis(i).GetElementsByTagName("a")
    If lsa(0).GetAttribute("className") = "title-box link" Then
        output.show(lsa(0).InnerHtml)
        output.show(lsa(0).GetAttribute("href"))
        Dim lsspan = lis(i).GetElementsByTagName("span")
        output.show(lsspan(0).InnerHtml & " " & lsspan(1).InnerHtml & " " & lsspan(2).InnerHtml)     
        Dim lsa1 = lis(i).GetElementsByTagName("p")
        If lsa1(0).GetAttribute("className") = "abstract" Then
            output.show(lsa1(0).InnerHtml)
        End If
    End If
Next


结果错误如楼上图一样:

 回到顶部
帅哥哟,离线,有人找我吗?
李孝春
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2472 积分:17346 威望:0 精华:0 注册:2013/1/31 0:03:00
回复:(有点蓝)别人给你的是一个思路,不是让你照搬...  发帖心情 Post By:2016/11/1 15:12:00 [显示全部帖子]

就是不懂他这个写法 图片点击可在新窗口打开查看 得学习 学习

 回到顶部
帅哥哟,离线,有人找我吗?
李孝春
  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2472 积分:17346 威望:0 精华:0 注册:2013/1/31 0:03:00
回复:(有点蓝)别人给你的是一个思路,不是让你照搬...  发帖心情 Post By:2016/11/1 16:26:00 [显示全部帖子]

有点蓝老师 麻烦指导下 谢谢:

下面就是我单独获取一个数据都出错,代码如下:
Dim web As new System.Windows.Forms.WebBrowser
web.ScriptErrorsSuppressed = True
web.Navigate("http://toutiao.com/m6051259851/")
Do Until web.ReadyState = 4 AndAlso web.Document.GetElementById("content-left") IsNot Nothing AndAlso web.Document.GetElementById("content-left").GetElementsByTagName("li").count > 0
    Application.DoEvents
Loop
Dim lis = web.Document.GetElementById("content-left").GetElementsByTagName("li")
For i As Integer = 0 To lis.count-1
   
    Dim lsa1 = lis(i).GetElementsByTagName("p")
    If lsa1(0).GetAttribute("className") = "abstract" Then
        output.show(lsa1(0).InnerHtml)
    End If

Next

图片点击可在新窗口打开查看此主题相关图片如下:11111.png
图片点击可在新窗口打开查看


 回到顶部
帅哥哟,离线,有人找我吗?
李孝春
  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2472 积分:17346 威望:0 精华:0 注册:2013/1/31 0:03:00
回复:(有点色) 查找元素用 GetElementsByTagN...  发帖心情 Post By:2016/11/2 9:16:00 [显示全部帖子]

感谢各位老师的大力支持与帮助,问题圆满解决!
整个代码如下:
Dim web As new System.Windows.Forms.WebBrowser
web.ScriptErrorsSuppressed = True
web.ScriptErrorsSuppressed = True
web.Navigate("http://toutiao.com/m6051259851/")
Do Until web.ReadyState = 4
    Application.DoEvents
Loop
Do Until web.DocumentText.contains("没有更多啦")
    web.Document.Window.ScrollTo(0, 0)
    web.Document.Window.ScrollTo(0, web.Document.Body.ScrollRectangle.Height)
    Application.DoEvents
Loop
Dim lis = web.Document.GetElementById("content-left").GetElementsByTagName("li")
Dim str As String = ""
For i As Integer = 0 To lis.count-1
    Dim lsa = lis(i).GetElementsByTagName("a")
    For Each a As object In lsa
        If a.GetAttribute("className") = "title-box link" Then
            str &= a.InnerHtml & vbcrlf
            str &= a.GetAttribute("href") & vbcrlf
            Dim lsspan = lis(i).GetElementsByTagName("span")
            str &= lsspan(0).InnerHtml & " " & lsspan(1).InnerHtml & " " & lsspan(2).InnerHtml & vbcrlf & vbcrlf
        End If
    Next
    Dim lsa1 = lis(i).GetElementsByTagName("p")
    For Each p As object In lsa1
        If p.GetAttribute("className") = "abstract" Then
            str &= p.InnerHtml & vbcrlf
        End If
    Next     
Next
output.Show(str)

 回到顶部
总数 11 1 2 下一页