主题：[求助]关于网页表格数据保存到狐表

参考代码

 

Dim web As New System.Windows.Forms.WebBrowser()
web.Navigate("http://cx.jljsw.com:8088/JLJGPublish/corpinfo/CorpInfo.aspx?rnd=" & Rand.NextDouble)
Do Until web.ReadyState = 4 AndAlso web.Document.GetElementById("tbody_CorpInfo").Innertext <> Nothing
    Application.DoEvents
Loop

'取数据
Dim Cols() As String = { "序号","企业名称","组织机构代码","所在市州","法定代表人","资质类型" }
Dim elems As object = web.Document.GetElementById("tbody_CorpInfo").GetElementsByTagName("tr")
Dim m As Integer = 0
For Each elem As object In elems
   
    Tables("企业列表").AddNew
    Dim tdelems As object =  elem.GetElementsByTagName("td")
    Dim i As Integer = 0
    For Each tdelem As object In tdelems
        Tables("企业列表").Current(Cols(i)) = tdelem.Innertext
        i = i + 1
    Next
    Tables("企业列表").Current("录入日期") = Date.Today
   
Next
Tables("企业列表").save

Dim web As New System.Windows.Forms.WebBrowser()
web.Navigate("http://cx.jljsw.com:8088/JLJGPublish/corpinfo/CorpInfo.aspx?rnd=" & Rand.NextDouble)
Do Until web.ReadyState = 4 AndAlso web.Document.GetElementById("tbody_CorpInfo").Innertext <> Nothing
    Application.DoEvents
Loop

'取数据
Dim Cols() As String = { "序号","企业名称","组织机构代码","所在市州","法定代表人","资质类型" }
Dim tcount = web.Document.GetElementById("lblPageCount1")

Dim elems As object = web.Document.GetElementById("tbody_CorpInfo").GetElementsByTagName("tr")
Dim felem = elems(0)
For Each elem As object In elems
    Tables("企业列表").AddNew
    Dim tdelems As object =  elem.GetElementsByTagName("td")
    Dim i As Integer = 0
    For Each tdelem As object In tdelems
        Tables("企业列表").Current(Cols(i)) = tdelem.Innertext
        i = i + 1
    Next
    Tables("企业列表").Current("录入日期") = Date.Today
   
Next
Dim count As Integer = 1
Do While count <= tcount.InnerText
    For Each ls As object In web.Document.GetElementsByTagName("li")
        If ls.InnerText.Contains("跳转至第") Then
            'Dim input = ls.GetElementsByTagName("input")(0)
            'Input.SetAttribute("value", "2")
        ElseIf ls.InnerText = "下一页" Then
            Dim input = ls.GetElementsByTagName("a")(0)
           
            Input.InvokeMember("click")
            Exit For
        End If
    Next
   
    Do Until web.Document.GetElementById("tbody_CorpInfo").GetElementsByTagName("tr")(0).InnerText <> felem.InnerText
        Application.DoEvents
    Loop
    Dim elemss = web.Document.GetElementById("tbody_CorpInfo").GetElementsByTagName("tr")
    felem = elemss(0)
    For Each elem As object In elemss
       
        Tables("企业列表").AddNew
        Dim tdelems As object =  elem.GetElementsByTagName("td")
        Dim i As Integer = 0
        For Each tdelem As object In tdelems
            Tables("企业列表").Current(Cols(i)) = tdelem.Innertext
            i = i + 1
        Next
        Tables("企业列表").Current("录入日期") = Date.Today
       
    Next
    'Exit Do
    count += 1
Loop

Tables("企业列表").save

 

不能，没办法。

 你要执行到最后，才会保存。

试试这样

 

Dim web As New System.Windows.Forms.WebBrowser()
web.Navigate("http://cx.jljsw.com:8088/JLJGPublish/corpinfo/CorpInfo.aspx?rnd=" & Rand.NextDouble)
Do Until web.ReadyState = 4 AndAlso web.Document.GetElementById("tbody_CorpInfo").Innertext <> Nothing
    Application.DoEvents
Loop

'取数据
Dim Cols() As String = { "序号","企业名称","组织机构代码","所在市州","法定代表人","资质类型" }
Dim tcount = web.Document.GetElementById("lblPageCount1")

Dim elems As object = web.Document.GetElementById("tbody_CorpInfo").GetElementsByTagName("tr")
Dim felem = elems(0)
For Each elem As object In elems
    Tables("企业列表").AddNew
    Dim tdelems As object =  elem.GetElementsByTagName("td")
    Dim i As Integer = 0
    For Each tdelem As object In tdelems
        Tables("企业列表").Current(Cols(i)) = tdelem.Innertext
        i = i + 1
    Next
    Tables("企业列表").Current("录入日期") = Date.Today
   
Next
Dim count As Integer = 1
Do While count <= tcount.InnerText
    For Each ls As object In web.Document.GetElementsByTagName("li")
        If ls.InnerText.Contains("跳转至第") Then
            'Dim input = ls.GetElementsByTagName("input")(0)
            'Input.SetAttribute("value", "2")
        ElseIf ls.InnerText = "下一页" Then
            Dim input = ls.GetElementsByTagName("a")(0)
           
            Input.InvokeMember("click")
            Exit For
        End If
    Next
   
    Dim ptime As Date = Date.Now
    Do Until web.Document.GetElementById("tbody_CorpInfo").GetElementsByTagName("tr")(0).InnerText <> felem.InnerText AndAlso (Date.now-ptime).TotalSeconds < 10
        Application.DoEvents
    Loop
    If web.Document.GetElementById("tbody_CorpInfo").GetElementsByTagName("tr")(0).InnerText <> felem.InnerText Then
        Dim elemss = web.Document.GetElementById("tbody_CorpInfo").GetElementsByTagName("tr")
        felem = elemss(0)
        For Each elem As object In elemss
           
            Tables("企业列表").AddNew
            Dim tdelems As object =  elem.GetElementsByTagName("td")
            Dim i As Integer = 0
            For Each tdelem As object In tdelems
                Tables("企业列表").Current(Cols(i)) = tdelem.Innertext
                i = i + 1
            Next
            Tables("企业列表").Current("录入日期") = Date.Today
           
        Next
    End If
    count += 1
Loop

Tables("企业列表").save

 

 那就是你网站有问题，你这个网站获取的数据本身就有问题。

 没办法，这个是你网站自身数据的问题。

 你网站读取的数据有问题，要不你就自己下一页下一页的点击测试。

 

 代码没法改。

做一个窗口，放一个webbrowser控件，然后用10楼的代码

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:网页表格数据保存到狐表表中例子.table