本帖最后由 引子玄 于 2012-12-26 14:03 编辑
Sub 文档与标签浏览小工具()
With CreateObject("InternetExplorer.Application")
.Visible = False
.Navigate "http://www.hao123.com"
Do Until .ReadyState = 4
DoEvents
Loop
MsgBox "文档大集合的个数" & .Document.all.Length
MsgBox "第1个文本" & vbCrLf & .Document.all(0).outerhtml
MsgBox "最后一个文本" & vbCrLf & .Document.all(.Document.all.Length - 1).outerhtml
MsgBox "层叠样式表个数" & .Document.all.tags("CSS").Length
MsgBox "框架个数" & .Document.all.tags("frame").Length
MsgBox "表格个数" & .Document.all.tags("table").Length
MsgBox "形状个数" & .Document.all.tags("form").Length
MsgBox "现在开始浏览已有标签的个数"
' MsgBox .Document.Forms(0).all(Index).innertext
' MsgBox .Document.Forms(1).all(Index).outerhtml
' MsgBox .Document.Forms(2).all(Index).innertext
arr = Split("标签号,a,abbr,acronym,address,applet,area,b,base,basefont,bdo,big,blockquote,body,br,button,caption,center,cite,code,col,colgroup,dd,del,dfn,dir,div,dl,dt,em,fieldset,font,form,frame,frameset,head,h1,h2,h3,h4,h5,h6,hr,html,i,iframe,img,input,ins,kbd,label,legend,li,link,map,menu,meta,noframes,noscript,object,ol,optgroup,option,p,param,pre,q,s,samp,script,select,small,span,strike,strong,style,sub,sup,table,tbody,td,textarea,tfoot,th,thead,title,tr,tt,u,ul,var", ",")
For i = 1 To UBound(arr)
w = arr(i)
If .Document.all.tags(w).Length > 0 Then
T = Timer
Application.StatusBar = w & "标签个数" & .Document.all.tags(w).Length
Do Until Timer > T + 1 '等待
DoEvents
Loop '等待
End If
Next
Application.StatusBar = False
递归:
TT = InputBox("请输入标签:", "提示:不输入按[确定]退出")
If TT <> "" Then
MsgBox TT & "标签个数" & .Document.all.tags(TT).Length
If .Document.all.tags(TT).Length > 0 Then
For i = 0 To .Document.all.tags(TT).Length - 1
Set WshShell = CreateObject("Wscript.Shell")
WshShell.Popup TT & "标签第" & i & "位的文本: " & vbCrLf & .Document.all.tags(TT)(i).outerhtml, 1, "请等待1秒钟,1秒后该窗口自动关闭"
Next
End If
End If
If TT <> "" Then GoTo 递归
.Quit
End With
End Sub
|