蓝天老师帮忙！请问，不显示的网页数据可以提取码

bailanhong

请问，不显示的网页数据可以提取码？
比如：http://www.nature-museum.net/Spdb/spsearch.aspx

liucqa

http://club.excelhome.net/thread-893760-1-1.html

bailanhong

liucqa 发表于 2013-4-10 09:58
http://club.excelhome.net/thread-893760-1-1.html

谢谢！

bailanhong

蓝天老师指导下！！！

592rmb

你说的不显示数据指的是网页上的哪些数据呀？

html2013

bailanhong 发表于 2013-4-10 22:18
蓝天老师指导下！！！

Sub nature_museum查询()
    On Error Resume Next
    With CreateObject("internetexplorer.application")
        .Visible = False
        .Navigate "http://www.nature-museum.net/Spdb/spsearch.aspx"
        While .ReadyState <> 4 Or .busy
            DoEvents
        Wend
        .document.getElementById("txtSearchName").value = "枫树"
        .document.getElementById("QueryCmd").Click
        Set r = .document.getElementById("QueryResult").All.tags("table")
        t1 = Timer
        ss = ""
        Do Until Timer > t1 + 1000
            ss = r(0).rows(0).Cells(1).innerText
            If ss <> "" Then GoTo 1
            DoEvents
            ss = ""
        Loop
1:
        For i = 0 To r.Length - 1
            Set r1 = r(i).rows
            Cells(i + 1, 1) = r1(0).Cells(1).innerText
        Next i
        Set r = Nothing
        .Quit
    End With
End Sub

html2013

bailanhong 发表于 2013-4-10 22:18
蓝天老师指导下！！！

Sub nature_museum查询()
    On Error Resume Next
    With CreateObject("internetexplorer.application")
        .Visible = False
        .Navigate "http://www.nature-museum.net/Spdb/spsearch.aspx"
        While .ReadyState <> 4 Or .busy
            DoEvents
        Wend
        .document.getElementById("txtSearchName").Value = "枫树"
        .document.getElementById("QueryCmd").Click
        Set r = .document.getElementById("QueryResult").All.tags("table")
        t1 = Timer
        ss = ""
        Do Until Timer > t1 + 1000
            ss = r(0).Rows(0).Cells(1).innerText
            If ss <> "" Then GoTo 1
            DoEvents
            ss = ""
        Loop
1:
        For i = 0 To r.Length - 1
            Set r1 = r(i).Rows
            temp = Split(r1(0).Cells(1).innerText, vbCrLf)
            Range(Cells(i + 1, 1), Cells(i + 1, UBound(temp))) = temp
            If Left(Cells(i + 1, "C"), 2) = "别名" Then
                Range("C" & i + 1).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        Next i
        Set r = Nothing
        .Quit
    End With
End Sub

bailanhong

html2013 发表于 2013-4-11 20:04
Sub nature_museum查询()
    On Error Resume Next
    With CreateObject("internetexplorer.applica ...

谢谢高手，如果我有要查询的列表文件呢，比如在A列，代码应该怎么改？谢谢！！！

html2013

bailanhong 发表于 2013-4-11 22:40
谢谢高手，如果我有要查询的列表文件呢，比如在A列，代码应该怎么改？谢谢！！！

.document.getElementById("txtSearchName").Value = cells(1,1)

bailanhong

html2013 发表于 2013-4-11 22:47
.document.getElementById("txtSearchName").Value = cells(1,1)

O(∩_∩)O谢谢！