如何只看汉风的帖子?时事专栏 于无声处听惊雷—从中巴军演谈 于无声处听惊雷上一句

蓝天630902

如何只看汉风的帖子?

现在,我为大家写一个Vba代码,形成全是汉风1918的帖子。请按下面的步骤操作:

一、在桌面新建一个名为“汉风1918惊雷贴”文件夹,

二、在“汉风1918惊雷贴”文件夹里面新建一个名为“说明.txt”的文本文档,打开“说明.txt”,请输入下面“*******”以内的内容(可以不要“*******”):

*******

1、打开”汉风1918惊雷贴.xlsm“

2、按 Alt+F11,再按F5

3、等待出现”OK“对话框,关闭”OK“对话框。关闭”汉风1918惊雷贴.xlsm“文件

4、打开”汉风1918惊雷贴.html“,里面全是 汉风1918的帖子。

下载需要一些时间,要耐心等待。

注意:请不要更改本“说明”文件的末尾的数字,这是下载的起始贴号,记录你的下载历史。

*******

保存,关闭。

三、在“汉风1918惊雷贴”文件夹里面新建一个名为“汉风1918惊雷贴.xls”的Excel文档,打开“汉风1918惊雷贴.xls”,按 Alt+F11,进入Excel的Vba环境,点击插入(N),再点击模块(M),把下面的的代码复制到模块1的窗口里面

Sub 汉风1918惊雷贴()

On Error Resume Next

Open ThisWorkbook.Path & "说明.txt" For Input As #1

Do While Not EOF(1)

Line Input #1, NextLine

a = NextLine

Loop

Close #1

Open ThisWorkbook.Path & "汉风1918惊雷贴.html" For Append As #1

Dim temp

With CreateObject("Microsoft.XMLHTTP")

.Open "GET", "http://" & "bbs.news.163.com/bbs/mil/1193698.html", False

.Send

tmp = Replace(.responseText, vbTab, " ")

temp = Split(Split(tmp, ".html""" & ">末页")(0), ",")

m = temp(UBound(temp))

Open ThisWorkbook.Path & "说明.txt" For Append As #2

Print #2, m

Print #2,

Close #2

If a < 1 Then

temp = Split(tmp, "javascript:BbsArticle.showUserinfoMenu")

For i = 0 To 1

Print #1, temp(i) & "javascript:BbsArticle.showUserinfoMenu"

Next i

Print #1, temp(2)

End If

For p = a + 1 To m

.Open "GET", "http://" & "bbs.news.163.com/bbs/mil/1193698.html", False

.Send

tmp = Replace(.responseText, vbTab, "")

temp = Split(tmp, "javascript:BbsArticle.showUserinfoMenu")

For i = 0 To UBound(temp) - 1

s = Trim(Split(temp(i), vbCrLf)(1))

If s = "汉风1918" Then

Print #1, "javascript:BbsArticle.showUserinfoMenu" & temp(i)

End If

Next i

Next p

End With

Close #1

MsgBox "ok"

如何只看汉风的帖子?【时事专栏】于无声处听惊雷—从中巴军演谈 于无声处听惊雷上一句
End Sub

四、点击保存,不要关闭,然后按F5。现在已经在下载了,因为内容比较多,需要一些时间,请耐心等待。出现OK以后,就可以关闭了。祝你好运!

...........................

Sub 汉风1918惊雷贴()

On Error Resume Next

If Dir(ThisWorkbook.Path & "说明.txt", vbDirectory) = "" Then '如果没有“C:验证码图片”文件夹则创建它,“验证码图片”是我定义的一个名字,你可以改变它

MkDir ThisWorkbook.Path & "说明.txt"

Open ThisWorkbook.Path & "说明.txt" For Append As #2

Print #2, "1、打开”汉风1918惊雷贴.xlsm“"

Print #2, "2、按 Alt+F11,再按F5"

Print #2, "3、等待出现”OK“对话框,关闭”OK“对话框。关闭”汉风1918惊雷贴.xlsm“文件"

Print #2, "4、打开”汉风1918惊雷贴.html“,里面全是 汉风1918的帖子。"

Print #2, "下载需要一些时间,要耐心等待。"

Print #2, "注意:请不要更改本“说明”文件的末尾的数字,这是下载的起始贴号,记录你的下载历史。"

Print #2, "0"

Close #2

End If

a = ""

Open ThisWorkbook.Path & "说明.txt" For Input As #1

Do While Not EOF(1)

Line Input #1, NextLine

a = a & "@" & NextLine

Loop

Close #1

temp = Split(a, "@")

For i = UBound(temp) - 1 To 0 Step -1

If Len(temp(i)) > 0 Then a = temp(i)

If Len(temp(i)) > 10 Then a = 0

Next i

Open ThisWorkbook.Path & "汉风1918惊雷贴.html" For Append As #1

Dim temp

With CreateObject("Microsoft.XMLHTTP")

.Open "GET", "http://" & "bbs.news.163.com/bbs/mil/1193698.html", False

.Send

Do Until .ReadyState = 4

DoEvents

Loop

tmp = Replace(.responseText, vbTab, " ")

temp = Split(Split(tmp, ".html""" & ">末页")(0), ",")

m = temp(UBound(temp))

Open ThisWorkbook.Path & "说明.txt" For Append As #2

Print #2, m

Print #2,

Close #2

If a < 1 Then

temp = Split(tmp, "javascript:BbsArticle.showUserinfoMenu")

For i = 0 To 1

Print #1, temp(i) & "javascript:BbsArticle.showUserinfoMenu"

Next i

Print #1, temp(2)

End If

For p = a + 1 To m

.Open "GET", "http://" & "bbs.news.163.com/bbs/mil/1193698," & p & ".html", False

.Send

Do Until .ReadyState = 4

DoEvents

Loop

tmp = Replace(.responseText, vbTab, "")

temp = Split(tmp, "javascript:BbsArticle.showUserinfoMenu")

For i = 0 To UBound(temp) - 1

s = Trim(Split(temp(i), vbCrLf)(1))

If s = "汉风1918" Then

Print #1, "javascript:BbsArticle.showUserinfoMenu" & temp(i)

End If

Next i

Next p

End With

Close #1

MsgBox "ok"

End Sub

..............................

Excel 2007 运行报错,修改了一下

Sub 汉风1918惊雷贴()

On Error Resume Next

If Dir(ThisWorkbook.Path & "说明.txt", vbDirectory) = "" Then '如果没有“C:验证码图片”文件夹则创建它,“验证码图片”是我定义的一个名字,你可以改变它

MkDir ThisWorkbook.Path & "说明.txt"

Open ThisWorkbook.Path & "说明.txt" For Append As #2

Print #2, "1、打开”汉风1918惊雷贴.xlsm“"

Print #2, "2、按 Alt+F11,再按F5"

Print #2, "3、等待出现”OK“对话框,关闭”OK“对话框。关闭”汉风1918惊雷贴.xlsm“文件"

Print #2, "4、打开”汉风1918惊雷贴.html“,里面全是 汉风1918的帖子。"

Print #2, "下载需要一些时间,要耐心等待。"

Print #2, "注意:请不要更改本“说明”文件的末尾的数字,这是下载的起始贴号,记录你的下载历史。"

Print #2, "0"

Close #2

End If

'a = ""

a = 0

Open ThisWorkbook.Path & "说明.txt" For Input As #1

Do While Not EOF(1)

Line Input #1, NextLine

a = a & "@" & NextLine

Loop

Close #1

temp = Split(a, "@")

For i = UBound(temp) - 1 To 0 Step -1

If Len(temp(i)) > 0 Then a = temp(i)

If Len(temp(i)) > 10 Then a = 0

Next i

Open ThisWorkbook.Path & "汉风1918惊雷贴.html" For Append As #1

'Dim temp

With CreateObject("Microsoft.XMLHTTP")

.Open "GET", "http://" & "bbs.news.163.com/bbs/mil/1193698.html", False

.Send

Do Until .ReadyState = 4

DoEvents

Loop

tmp = Replace(.responseText, vbTab, " ")

temp = Split(Split(tmp, ".html""" & ">末页")(0), ",")

m = temp(UBound(temp))

Open ThisWorkbook.Path & "说明.txt" For Append As #2

Print #2, m

Print #2,

Close #2

If a < 1 Then

temp = Split(tmp, "javascript:BbsArticle.showUserinfoMenu")

For i = 0 To 1

Print #1, temp(i) & "javascript:BbsArticle.showUserinfoMenu"

Next i

Print #1, temp(2)

End If

For p = a + 1 To m

.Open "GET", "http://" & "bbs.news.163.com/bbs/mil/1193698," & p & ".html", False

.Send

Do Until .ReadyState = 4

DoEvents

Loop

tmp = Replace(.responseText, vbTab, "")

temp = Split(tmp, "javascript:BbsArticle.showUserinfoMenu")

For i = 0 To UBound(temp) - 1

s = Trim(Split(temp(i), vbCrLf)(1))

If s = "汉风1918" Then

Print #1, "javascript:BbsArticle.showUserinfoMenu" & temp(i)

End If

Next i

Next p

End With

Close #1

MsgBox "ok"

End Sub

.............................

引用35472楼gubulin的发言:

需要用VB生成EXE文件吗?

不需要生成EXE,这段代码是VBA代码直接在EXCEL中运行,需要注意的是:

1、EXCEL 2007 需要另存为 xlsm 格式,否则无法将本段代码保存到EXCEL中,下次运行仍然需要复制、粘贴。

2、不管 xlsm 文件保存在哪个目录,该目录下一定要新建 "说明.txt" 文件,否则会出现一个 "说明.txt"的文件夹

3、下载完后不要删除 "说明.txt" 文件,该文件中记载了最后下载的页码。

最终下载的文档接近8M

......................

  

爱华网本文地址 » http://www.413yy.cn/a/25101011/95105.html

更多阅读

如何办理建筑业企业资质的年检? 建筑业企业资质标准

如何办理建筑业企业资质的年检?——简介建筑业企业的资质是证明企业能够从事某一范围内的建筑活动的证明书。建筑类企业资质的等级标准也很多,需要符合条件后才能申报,审核后才能获得相应等级的资质。资质每一年在有效期到期之前都必须

当春乃发生的上一句及其全诗鉴赏 当春乃发生上一句

当春乃发生的上一句及其全诗鉴赏当春乃发生的上一句是好雨知时节;“好雨知时节,当春乃发生”是出自唐代诗人杜甫的《春夜喜雨》;好雨知时节,当春乃发生全诗鉴赏:好雨知时节,当春乃发生。随风潜入夜,润物细无声。野径云俱黑,江船火独明。晓看

如何看清“北爱”的演职人员? 在职人员

《北京爱情故事》诉讼版(第二季)如何看清“北爱”的演职人员?《北京爱情故事》是非常好的一部青春偶像剧,开播以来,赢得了社会好评,公众的热情不减。大家公认,“北爱”确实很好,但是很多人无法知道好在哪里,其实,一部好的影视作品的成功,离不

吹面不寒杨柳风的上一句及其全诗鉴赏 吹面不寒杨柳风

吹面不寒杨柳风的上一句及其全诗鉴赏吹面不寒杨柳风的上一句是沾衣欲湿杏花雨;“沾衣欲湿杏花雨,吹面不寒杨柳风。”是出自南宋诗人僧志南的《绝句》;沾衣欲湿杏花雨,吹面不寒杨柳风全诗鉴赏:古木阴中系短篷,杖藜扶我过桥东。沾衣欲湿杏花

声明:《如何只看汉风的帖子?时事专栏 于无声处听惊雷—从中巴军演谈 于无声处听惊雷上一句》为网友特别人分享!如侵犯到您的合法权益请联系我们删除