第二辑、网页：篡改、保留和屏蔽某些内容

蓝天630902

我们在　第一辑、网页：点击标签，翻页　http://club.excelhome.net/thread-874608-1-1.html
里面讲过如何关闭那些讨厌的东西，但效果不是很好，主要是随着时间的流逝，标签号改变了。
有没有更好的办法解决这样的问题呢？答案是肯定的（不过不要高兴得太早了，哪一天，它连标签名都给改了，就没辙了）
看看下面的方法与第一辑、网页：点击标签，翻页　http://club.excelhome.net/thread-874608-1-1.html的有什么不同：

1. Sub 关闭讨厌的家伙()
   
2.     On Error Resume Next
   
3.     With CreateObject("internetexplorer.application")
   
4.         .Visible = True
   
5.         .Navigate "http://de.yusuan.com/page_content.asp?content=98"
   
6.         Do Until .ReadyState = 4
   
7.             DoEvents
   
8.         Loop
   
9.         t1 = Timer
   
10.         Do Until Timer > t1 + 5    '这里等5秒，主要是让右侧的讨厌的家伙全部出现，然后关闭它
    
11.             DoEvents
    
12.         Loop
    
13.         For i = 0 To .document.All.tags("div").Length
    
14.             If .document.All.tags("div")(i).ID = "tq_invit_close" Then .document.All.tags("div")(i).Click '关闭“网站管理员请求和您通话（本系统由TQ提供）”
    
15.             If .document.All.tags("div")(i).ID = "tq_float_close" Then .document.All.tags("div")(i).Click '关闭“筑业在线客服”
    
16.             If .document.All.tags("div")(i).ID = "TQMiniMessWrap" Then .document.All.tags("div")(i).innerHTML = "" '关闭“筑业软件留言系统”
    
17.         Next i
    
18.     End With
    
19. End Sub
    

复制代码

蓝天630902

其实呢，上面的还可以做得更干净些：

1. Sub 关闭讨厌的家伙()
   
2.     On Error Resume Next
   
3.     With CreateObject("internetexplorer.application")
   
4.         .Visible = True
   
5.         .Navigate "http://de.yusuan.com/page_content.asp?content=98"
   
6.         Do Until .ReadyState = 4
   
7.             DoEvents
   
8.         Loop
   
9.         t1 = Timer
   
10.         Do Until Timer > t1 + 5    '这里等5秒，主要是让右侧的讨厌的家伙全部出现，然后关闭它
    
11.             DoEvents
    
12.         Loop
    
13.         For i = 0 To .document.All.tags("div").Length
    
14.             If .document.All.tags("div")(i).ID = "tq_invit_close" Then .document.All.tags("div")(i).Click    '关闭“网站管理员请求和您通话（本系统由TQ提供）”，通过ｉｄ查找
    
15.             If .document.All.tags("div")(i).ID = "tq_float_close" Then .document.All.tags("div")(i).Click    '关闭“筑业在线客服”
    
16.             If .document.All.tags("div")(i).ID = "TQMiniMessWrap" Then .document.All.tags("div")(i).innerHTML = ""    '关闭“筑业软件留言系统”
    
17.             If .document.All.tags("div")(i).className = "content_divs_body_cnsL2" Then .document.All.tags("div")(i).innerHTML = ""    '屏蔽“典型客户”，通过类名查找
    
18.             If .document.All.tags("div")(i).className = "content_divs_body_cnsR" Then .document.All.tags("div")(i).innerHTML = ""    '屏蔽“筑业软件全国服务网络”
    
19.         Next i
    
20.     End With
    
21. End Sub

复制代码

cumulonimbus

蓝天630902 发表于 2012-9-14 08:48
其实呢，上面的还可以做得更干净些：

找关闭广告的代码要看ID、CLASSNAME，有些名字特复杂，要如何判断。
比如：http://cache.3q3q.cc:8585/kehuan/11369/
这个网站，我看了半天也没看出哪个是要关闭的按钮？谢谢

cumulonimbus

蓝天630902 发表于 2012-9-14 08:48
其实呢，上面的还可以做得更干净些：

你这个网站http://de.yusuan.com/page_content.asp?content=98
找关闭广告的代码要看ID、CLASSNAME，有些名字特复杂，要如何判断。
你是如何迅速找出的，你看DIV的classname、id非常多，有几十个，有些靠英文能猜出来，有些的意思却不大好明白。有什么快速的好办吗？

蓝天630902

cumulonimbus 发表于 2012-9-14 14:34
你这个网站http://de.yusuan.com/page_content.asp?content=98
找关闭广告的代码要看ID、CLASSNAME，有些 ...

Sub 先看一个东方财富()
    On Error Resume Next
    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .navigate "http://www.eastmoney.com/"
        Do Until .readyState = 4
            DoEvents
        Loop
        k = 0
        For i = 1 To .document.All.Length - 1
            If .document.All(i).innerText = "关闭" Then
                k = k + 1
                Cells(k, 1) = .document.All(i).tagName
                .document.All(i).innerHTML = ""
            End If
        Next i
    End With
End Sub

'这里为什么是“innerText”而不是别的什么呢？
'这是因为两边的广告中的“关闭”是可以复制的“文本”，一般来说“innerText”可见并能复制
'所以这里直接采用“innerText”
'下面再说说“http://de.yusuan.com/page_content.asp?content=98”

cumulonimbus

蓝天630902 发表于 2012-9-14 15:18
Sub 先看一个东方财富()
    On Error Resume Next
    With CreateObject("InternetExplorer.Applicat ...

Sub 可视化查找()
    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .navigate "http://www.people.com.cn/n/2012/0912/c346186-18987485.html"
        Do Until .readyState = 4
            DoEvents
        Loop
        For i = 0 To .document.All.tags("input").Length - 1
            .document.All.tags("input")(i).Width = 100
            .document.All.tags("input")(i).Height = 100

            .document.All.tags("input")(i).Value = i
            .document.All.tags("input")(i).Style.Color = "red"
        Next i
    End With
End Sub
我发现这个程序对人民网不管用哈

蓝天630902

cumulonimbus 发表于 2012-9-14 15:29
Sub 可视化查找()
    With CreateObject("InternetExplorer.Application")
        .Visible = True

又绕进去了，到别的地方去。

现在讲“http://de.yusuan.com/page_content.asp?content=98”，

Sub 再看筑业网()
    On Error Resume Next
    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .navigate "http://de.yusuan.com/page_content.asp?content=98"
        Do Until .readyState = 4
            DoEvents
        Loop
        t1 = Timer
        Do Until Timer > t1 + 5    '这里等5秒，主要是让右侧的讨厌的家伙全部出现
            DoEvents
        Loop
        k = 0
        For i = 1 To .document.All.Length - 1
            If .document.All(i).innerText = "筑业在线客服" Or .document.All(i).innerText = "筑业软件留言系统" Or Left(.document.All(i).innerText, 11) = "网站管理员请求和您通话" Then
                k = k + 1
                Cells(k, 1) = .document.All(i).tagName
                .document.All(i).parentElement.innerHTML = ""
            End If
        Next i
    End With
End Sub

'这里“筑业在线客服”、“筑业软件留言系统”以及“网站管理员请求和您通话（本系统由TQ提供）”都是是可以复制的“文本”。所以也采用“innerText”。
'可是，只是关闭了右下角的，左边只是闪了一下，没关闭；中间的根本就是不反应。
'有点头昏！现在。
'

cumulonimbus

蓝天630902 发表于 2012-9-14 15:52
又绕进去了，到别的地方去。

现在讲“http://de.yusuan.com/page_content.asp?content=98”，

奇怪，为什么关不掉呢？

引子玄

蓝天630902 发表于 2012-9-10 04:59
我们，还可以改变它的文字内容：

关于“清除标签内容”的做法，是否可以借用到XMLHTTP对象的“网页采集”中？
比如：
1、对源码中<div>、、、</div>中的内容提取，XMLHTTP采集来个反向清除，剩下的就是DIV标签内的文本内容了。
2、能否把OUTERHTML的标签提取，引用到XMLHTTP的源码提取中。

蓝天630902

引子玄 发表于 2012-9-14 20:09
关于“清除标签内容”的做法，是否可以借用到XMLHTTP对象的“网页采集”中？
比如：对源码中、、、中的 ...

XMLHTTP对象，没有像ｉｅ对象那样的丰富的“标签”元素，所以，操作起来只能死气沉沉地用“Replace , Split　”方法，但是它速度快。
关于“清除标签内容”的做法，是否可以借用到XMLHTTP对象的“网页采集”中，我真不清楚。

Vba是微软的，ie是微软的，他们之间很多功能没有挖掘。

Sub 比如说吧()
    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .navigate "http://baidu.lehecai.com/lottery/qlc/"
        Do Until .readyState = 4
            DoEvents
        Loop
        .document.body.Style.Zoom = "200%"    '屏幕放大2倍
        For i = 0 To .document.All.tags("input").Length - 1
            .document.All.tags("input")(i).Value = .document.All.tags("input")(i).ID
            If .document.All.tags("input")(i).ID = "standard_add_to_list_btn" Then .document.All.tags("input")(i).ScrollIntoView    '定位到第i个input元素（input标签）位置
        Next i
    End With
End Sub