网页导入excel问题，请帮忙看下这段代码。

mantou008 · 发表于 2011-7-28 11:45

请帮忙看下这段代码，从《分享网页数据下载与控制》帖子中获取并修改，with一句出现编译错误，缺少参数，我不太懂请帮忙改改。只要取得文章名和日期就行。谢谢了。网站数据是分页的，第一页和最后一页的网址都是一样的。
Private Sub CommandButton1_Click()
weburl = "URL;http://www.linyi.gov.cn/all/all.htm1?colid=282"
Strpost = "year_start=%202011&month_start=%201&date_start=%201&" & _
"hour_start=%200" & _
"&year_end=%202011&month_end=%207&date_end=%2030&hour_end=%200" & _
"&substation%5B%5D=00&R1=sortall&order=1&desckey="

With Exsheet.QueryTables.Add(Connection:=weburl, & _
Destination:=Exsheet.Range("a1"))
      .PostText = Strpost       'post字串
      .BackgroundQuery = True
      .WebSelectionType = xlSpecifiedTables
      .WebTables = "1"    '导入网页中的第一个表，也只有一个表格，网页上可能会包含很多个表格，表格让你组织网页内容。当在记事本里查看HTML源代码时，你会发现通过下述标签你很容易识别这些表格：<TABLE>（表格开始）和</TABLE>（表格结束）
      .WebFormatting = xlWebFormattingAll
      .RefreshStyle = xlOverwriteCells
      .AdjustColumnWidth = True
      On Error GoTo Wlcw
      .Refresh BackgroundQuery:=False    '发送命令？
      On Error GoTo 0
      .SaveData = True
End With
'数据已写入到EXCEL
……

Wlcw:    '网络不通
If P_cxzlly = "sccx" Or P_cxzlly = "qmcx" Then
      aa = MsgBox("网络不通,请手动打开网络试试!", vbOKOnly, "提示")
End If
Exit Sub

[ 本帖最后由 mantou008 于 2011-7-28 16:28 编辑 ]

xmyjk · 发表于 2011-7-28 12:40

Sub Macro1() '
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.linyi.gov.cn/all/all.htm1?colid=282", Destination:=Range("A1" _
))
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.AdjustColumnWidth = True
.WebSelectionType = xlSpecifiedTables
.WebTables = "8"
.Refresh BackgroundQuery:=False
End With
End Sub

复制代码

mantou008 · 发表于 2011-7-28 16:25

谢谢xmyjk的热心帮助，但是上面那段代码执行之后，只有第一页的内容，不知道如何解决？

mantou008 · 发表于 2011-7-28 17:33

自己顶一下，请高手帮忙。

xmyjk · 发表于 2011-7-28 23:14

原帖由 mantou008 于 2011-7-28 17:33 发表
自己顶一下，请高手帮忙。

http://www.linyi.gov.cn/all/all.htm1?currpage=5&colid=282

把上述网址红色部分做一个变量，循环运行程序。

mantou008 · 发表于 2011-7-29 09:28

我不太懂，弄了半天不行，能不能帮我写出来？谢谢

mantou008 · 发表于 2011-7-29 11:40

我修改了下，不知道那个a1单元格要如何循环，才能使所有数据都出来。
Sub chaxun()
Dim i
For i = 1 To 60
With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.linyi.gov.cn/all/all.htm1?currpage=" & i & "&colid=282", Destination:=Range("a1"))
      .BackgroundQuery = True
      .RefreshStyle = xlOverwriteCells
      .AdjustColumnWidth = True
      .WebSelectionType = xlSpecifiedTables
      .WebTables = "8"
      .Refresh BackgroundQuery:=false
End With

Next i
End Sub

[ 本帖最后由 mantou008 于 2011-7-29 11:50 编辑 ]

mantou008 · 发表于 2011-7-29 12:03

已经解决，虽然还有点小问题，但是数据已经下来，谢谢上旋下弦月的帮助。另外不知道如何去除数据的链接？
Sub chaxun()
Dim i
Dim j
For i = 1 To 60
j = 1 + 25 * (i - 1)
With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.linyi.gov.cn/all/all.htm1?currpage=" & i & "&colid=282", Destination:=Range("A" & j))
      .BackgroundQuery = True
      .RefreshStyle = xlOverwriteCells
      .AdjustColumnWidth = True
      .WebSelectionType = xlSpecifiedTables
      .WebTables = "8"
      .Refresh BackgroundQuery:=True
End With

Next i
End Sub

[ 本帖最后由 mantou008 于 2011-7-29 12:06 编辑 ]

xmyjk · 发表于 2011-8-1 01:06

Option Explicit
Sub a()
Dim ie1 As Object, dmt As Object, r As Object, i As Long, j As Long, n As Long, p As Integer
'Load UserForm1
'UserForm1.Show 0
[a1].CurrentRegion.Clear
Cells.NumberFormat = "@"
Set ie1 = UserForm1.WebBrowser1
For p = 1 To 164
n = [a65536].End(3).Row + 1
With ie1
.Navigate "http://www.linyi.gov.cn/all/all.htm1?currpage=" & p & "&colid=282" '网址
Do Until .ReadyState = 4
DoEvents
Loop
Set dmt = .Document
Set r = dmt.All.tags("table")(7).Rows
For i = 0 To r.Length - 2
For j = 0 To r(i).Cells.Length - 1
Cells(i + n, j + 1) = r(i).Cells(j).innerText
Next
Next
Set dmt = Nothing
Set r = Nothing
End With
Next
Set ie1 = Nothing
[a1] = "标题": [b1] = "日期"
[a1].CurrentRegion.Columns.AutoFit
End Sub

复制代码

xmyjk · 发表于 2011-8-1 01:11

试看看附件。

		自动登录	找回密码
密码			免费注册

[求助] 网页导入excel问题，请帮忙看下这段代码。

回复 2楼 xmyjk 的帖子

回复 5楼 xmyjk 的帖子

另一种做法，代码如下，附件等候。