主题：[求助][求助][求助]网络数据获取占用大量内存，有何解决办法？还是没搞定

 取决于你的表的数量和表的数据的数量，越多，占用越大。

 你可以不加载那么多数据。

 不是数据丢失，这个是异步执行的，慢一些。

 没发觉内存会变多大，你数据很多吗？

 抱歉，测试确实有点问题，如果是内存的事，就改一下这句代码

Dim  Tbl As Table = Tables("公告")
Dim  Dom As Object, Str As String, i As Integer,j As Integer
'ObjIE As Object,ObjIE = CreateObject("InternetExplorer.Application")
Dim  web As New System.Windows.Forms.WebBrowser()
Dim webs As New System.Windows.Forms.WebBrowser()
web.ScriptErrorsSuppressed = False
'labpro.Text = "开始加载数据..."
'Barpro.Value = 30
With web
    For i= 0 To 3
        j+=1
        If i = 0 Then
            Str = "http://www.qhei.gov.cn/zbycg/zbgg/default.shtml"
            .Navigate(Str)'网址
        Else
            Str = "http://www.qhei.gov.cn/zbycg/zbgg/default_" & i & ".shtml"
            .Navigate(Str)
           
        End If
        Do Until .ReadyState = 4
            Application.DoEvents
        Loop
        Dom = .Document
       
        Dim elems As object = Dom.GetElementById("table7").GetElementsByTagName("table")
        If  elems IsNot dbnull.value Then
            For Each elem As object In elems
                Dim  tdelems As object =  elem.GetElementsByTagName("td")
                For Each tdelem As object In tdelems
                   
                    webs.ScriptErrorsSuppressed = False
                    Dim href As String
                    If tdelem.Children.count > 1 Then
                        href = tdelem.Children(1).GetAttribute("href")                'CurrentTable.Current("招标网址")
                    End If
                    webs.Navigate(href)
                    Do  Until webs.ReadyState = 4
                        Application.DoEvents
                    Loop
                    Dim Doms As object = Webs.Document
                    Dim Con As object = Doms.GetElementByID("Table7")    '.GetElementsByTagName("Table").getElementsByTagName("TRS_Editor")
                    Dim conhtmls As String = "<div align= 'Center' width = '100%'><style>#table7{width:100%} #Table7 tr td font p{display:none}</style> " & Con.OuterHtml & "</div>"
                    Dim conhtml As String
                    If  ConHtmls.Indexof("一篇") > 0 Then
                        conhtml = conhtmls.Substring(0,conhtmls.IndexOf("一篇"))
                       
                    Else
                        conhtml = Conhtmls
                    End If
                    If tdelem.Innertext > "" AndAlso ConHtml.Indexof("监理") >0 Then
                        Dim R As Row
                        If tdelem.Children.count > 1 Then
                            Dim dr As DataRow = DataTables("公告").Find("[名称] ='"& tdelem.Children(1).innerText.trim() &"'")
                            If  dr Is Nothing Then
                                R = Tbl.Rows.AddNew
                               
                                R("名称") = tdelem.Children(1).innerText.trim()                          'AndAlso tdelem.Children.count > 1  tdelem.Children(1).innerText.trim()
                                R("日期") = tdelem.InnerText.Trim().SubString(tdelem.Innertext.IndexOf("[")-3).Trim(" ","[","]")
                                R("内容") = conhtmls   '"<div align= 'Center' width = '100%'><style>#table7{width:100%} #Table7 tr td font{display:none}</style> " & Con.OuterHtml & "</div>"
                               
                            End If
                        End If
                        'Barpro.Value = Barpro.Value + 1
                    End If
                Next
            Next
           
        Else
            messagebox.show("数据获取失败,请检查网络!","提示")
        End If
    Next
   
   
End With
'ObjIE.Quit
If DataTables("公告").HasChanges Then
    StatusBar.Message1 = "数据获取完成..."
   
    Messagebox.show("数据已更新","提示")
   
    'labpro.Text = "数据已更新"
    'Barpro.Value = 100
    DataTables("公告").Save()
   
    StatusBar.Reset
Else
    'labpro.Text = "数据已最新"
    'Barpro.Value = 100
    Messagebox.show("数据已最新","提示")
End If

'labpro.Text = "数据加载完成..."
'Barpro.Value = 100
DataTables("公告").LoadOrder = "招标日期 Desc"

DataTables("公告").Load()