[已解决]运行时出现“对象不支持该属性或方”错误？请老师们帮助！

gwfzh

hwc2ycy 发表于 2013-1-25 18:23

谢谢hwc2ycy老师：能否将网页中的表格数据复制粘贴到excel表中呢，希望老师能继续给予帮助！谢谢了！

hwc2ycy

你能不能把要求一次说完了，一层层剥，写一次，思路又断了，又有新的来。

gwfzh

hwc2ycy 发表于 2013-1-25 23:11
你能不能把要求一次说完了，一层层剥，写一次，思路又断了，又有新的来。

不好意思，这是点击该网页的最后一个目的，不知怎么的，将老师你的代码加上另外的代码后不能复制下载网页上的表格数据！请老师继续帮忙了！
Sub LOADIE()   '在代码的常见的处理情况
    Set iea = CreateObject("InternetExplorer.Application")
    iea.Visible = True
    iea.Navigate "http://www.pinble.com/Lottery.htm"  '←打开某个网页，要一定时间，但代码会往下执行
    Do Until iea.ReadyState = 4    '检查网页是否加载完毕（4表示完全加载）
        DoEvents                '循环中交回工作权限给系统，以免“软死机”
    Loop
    'Set doc = iea.Document
    With iea
        Set R = .Document.all.tags("a")
        For i = 1 To R.Length
            If R(i).innerText = "七星彩" Then
                R(i).Click
                Exit Sub
            End If
            'End If
        Next i
      
‘下载复制数据
Do Until iea.ReadyState = 4    '检查网页是否加载完毕（4表示完全加载）
        DoEvents                '循环中交回工作权限给系统，以免“软死机”
    Loop
        Set dmt = .Document
        For i = 0 To dmt.all.tags("table").Length - 1
            If InStr(dmt.all.tags("table")(i).innerText, "七星彩 开奖信息") > 0 Then x = i
        Next
    Set R1 = dmt.all.tags("table")(x).Rows
    For i = 0 To R1.Length - 1
        For j = 0 To R1(i).Cells.Length - 1
            Sheet3.Cells(i + 1, j + 1) = R1(i).Cells(j).innerText
        Next
    Next ' 在工具文件窗体上有这个例子
    End With
   
End Sub

hwc2ycy

1. Sub LOADIE()   '在代码的常见的处理情况
   
2.     Set iea = CreateObject("InternetExplorer.Application")
   
3.     iea.Visible = True
   
4.     iea.Navigate "http://www.pinble.com/Lottery.htm"  '←打开某个网页，要一定时间，但代码会往下执行
   
5.     Do Until iea.ReadyState = 4    '检查网页是否加载完毕（4表示完全加载）
   
6.         DoEvents                '循环中交回工作权限给系统，以免“软死机”
   
7.     Loop
   
8.     With iea
   
9.         Set R = .Document.all.tags("a")
   
10.         For i = 1 To R.Length
    
11.             If R(i).innerText = "七星彩" Then
    
12.                 R(i).Click
    
13.                 Exit For
    
14.             End If
    
15.         Next i
    
16. 
    
17.         '下载复制数据
    
18.         Do Until .ReadyState = 4    '检查网页是否加载完毕（4表示完全加载）
    
19.             DoEvents                '循环中交回工作权限给系统，以免“软死机”
    
20.         Loop
    
21.         Set dmt = .Document.all.tags("table")
    
22.         MsgBox "开始提取"
    
23.         'For i = 1 To dmt.Length - 1
    
24.         '    If dmt(i).ID = "MyGridView" Then x = i: Exit For
    
25.         'Next
    
26.         Set r1 = dmt(11).Rows
    
27.         For i = 0 To r1.Length - 2
    
28.             For j = 0 To r1(i).Cells.Length - 1
    
29.                 Cells(i + 1, j + 1) = r1(i).Cells(j).innerText
    
30.             Next
    
31.         Next    ' 在工具文件窗体上有这个例子
    
32.     End With
    
33. End Sub

复制代码

hwc2ycy

1. Sub LOADIE()   '在代码的常见的处理情况
   
2.     Application.ScreenUpdating = False
   
3.     Cells.Clear
   
4. 
   
5.     Set iea = CreateObject("InternetExplorer.Application")
   
6.     'iea.Visible = True
   
7.     iea.Navigate "http://www.pinble.com/Lottery.htm"  '←打开某个网页，要一定时间，但代码会往下执行
   
8.     Do Until iea.ReadyState = 4    '检查网页是否加载完毕（4表示完全加载）
   
9.         DoEvents                '循环中交回工作权限给系统，以免“软死机”
   
10.     Loop
    
11.     With iea
    
12.         Set R = .Document.all.tags("a")
    
13.         For i = 1 To R.Length
    
14.             If R(i).innerText = "七星彩" Then
    
15.                 R(i).Click
    
16.                 Exit For
    
17.             End If
    
18.         Next i
    
19. 
    
20.         '下载复制数据
    
21.         Do Until .ReadyState = 4    '检查网页是否加载完毕（4表示完全加载）
    
22.             DoEvents                '循环中交回工作权限给系统，以免“软死机”
    
23.         Loop
    
24.         Set dmt = .Document.all.tags("table")
    
25.         MsgBox "开始提取"
    
26.         'For i = 1 To dmt.Length - 1
    
27.         '    If dmt(i).ID = "MyGridView" Then x = i: Exit For
    
28.         'Next
    
29.         Set r1 = dmt(11).Rows
    
30.         For i = 0 To r1.Length - 2
    
31.             For j = 0 To r1(i).Cells.Length - 1
    
32.                 Cells(i + 1, j + 1) = r1(i).Cells(j).innerText
    
33.             Next
    
34.         Next    ' 在工具文件窗体上有这个例子
    
35.         .Quit
    
36.     End With
    
37.     Set iea = Nothing
    
38.     Application.ScreenUpdating = True
    
39. End Sub

复制代码

gwfzh

hwc2ycy 发表于 2013-1-25 18:23

谢谢hwc2ycy老师：在你多次的帮助下，顺利解决了问题！

hwc2ycy

你这个贴子不错，以前没这么操作过，我也学习了。