关于网页码源下载求助的答复(昨天回了个求助，又被楼主锁权限了，现贴出我回帖内容)

xmyjk

原帖：http://club.excelhome.net/thread-771384-1-2.html

又被锁权限了。

唉，最近这样情况越来越多了。其实也知道你是为什么。懒得理你了。

建议社区再控制下新人的权限吧，特别是帖子的管理权限，新人一律不准设置帖子的权限。不然这类事情还会发生。

弄得俺现在也是，没有一定积分的朋友的求助，还真的有点犹豫，敢不敢帮忙的。

另外也提倡下，如果帖子被锁了，就另贴发程序代码共享出来，免得他们有其他目的。

资源是共享的，现将我的解题代码和程序另帖子发出。

原求助内容：

将：http://ks.cn.yahoo.com/dir/97316761_over.html?page=1的页面的第一页到第十页的页面源代码中。

将每页中<th>时间</th>至</tbody>的源代码截取并批量一次性下载到TXT文件中。

解决代码：

1. Option Explicit
   
2. Sub test()
   
3.     Dim getpage As String, p%, xmlhttp As Object
   
4.    
   
5.     Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
   
6.     If Len(Dir(ThisWorkbook.Path & "\d123.txt")) > 0 Then Kill ThisWorkbook.Path & "\d123.txt"
   
7.     For p = 1 To 10
   
8.        With xmlhttp
   
9.            .Open "get", "http://ks.cn.yahoo.com/dir/97316761_over.html?page=" & p, False
   
10.            .send
    
11.            getpage = Split(Split(.responsetext, "<th>时间</th>")(1), "</tbody>")(0)
    
12.        End With
    
13.        Open ThisWorkbook.Path & "\d123.txt" For Append As #1
    
14.        Print #1, getpage
    
15.        Close #1
    
16.        getpage = ""
    
17.     Next
    
18. 
    
19.     Set xmlhttp = Nothing
    
20.    
    
21.     MsgBox "Ok"
    
22. End Sub
    

复制代码

该贴已经同步到 xmyjk的微博

flysum2008

顶，学习xmyjk 老师这种分享精神！谢谢！

xmyjk

flysum2008 发表于 2011-10-6 11:13
顶，学习xmyjk 老师这种分享精神！谢谢！

呵呵，客气了，老师不敢当，大家一起学习呗。

呵呵，最近也看到你的不错的学习经验分享帖。

{:soso_e179:}，很多值得借鉴的地方。

wudixin96

支持XM的想法，现在太多目的性太强的新会员了，纯粹把好心当成工具了

xmyjk

wudixin96 发表于 2011-10-6 11:19
支持XM的想法，现在太多目的性太强的新会员了，纯粹把好心当成工具了

哇，谢谢敌哥支持{:soso_e102:}，仰望崇拜中{:soso_e191:}

CTFuture

鼎立支持！{:soso_e182:}

xiaoqiu88

解决完封贴？

wpxxsyzx

我遇到两次了，问题很相似，估计是一个人，多次注册

jiminyanyan

这种人，下次不要帮他了哦。

jinsha2002

鼎立支持！