登陆网页获取信息，终于做出来了，分享一下，

lulu8988

网页：https://448282.yichafen.com/public/queryscore/sqcode/OsDcQnymODU4fDFhYWVkNzBjODBkMGQzYmRlZWRlNWZiNzVlMDZlOTEzfDQ0ODI4MgO0O0OO0O0O.html
（自建的网页查询，不涉及别人的隐私）

终于做出来自已想要的样子了，感谢各位曾给于指导的老师，谢谢!!
现发出来分享一下，一起学习，

Sub 测试4()
'''''''''''''''''''''要把IE浏览器设置成默认的浏览器
Dim aaa%, n%, str As String
aaa = Sheet1.Columns(1).Find("*", , xlFormulas, , , xlPrevious).Row
For n = 2 To aaa
    Dim IE As InternetExplorer
    Dim doc As HTMLDocument
    Set IE = New InternetExplorer
    IE.navigate "https://448282.yichafen.com/public/queryscore/sqcode/OsDcQnymODU4fDFhYWVkNzBjODBkMGQzYmRlZWRlNWZiNzVlMDZlOTEzfDQ0ODI4MgO0O0OO0O0O.html"
    IE.Visible = False

    Do
      DoEvents
    Loop Until IE.readyState = 4

    Set doc = IE.document
    doc.getElementById("s_xingming").Value = Sheet1.Range("a" & n)
    doc.getElementById("s_kaohao").Value = Sheet1.Range("b" & n)
    doc.getElementById("yiDunSubmitBtn").Click

   Application.Wait (Now + TimeValue("00:00:02"))

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Obj As Object
    On Error Resume Next
    For Each Obj In CreateObject("Shell.Application").Windows
        If TypeName(Obj.document) = "HTMLDocument" Then

        Sheet1.Range("i" & n) = Obj.LocationURL

        End If
    Next


If Sheet1.Range("i" & n) = "https://448282.yichafen.com/public/queryresult.html" Then

     my_string = IE.document.all.tags("html")(0).outerHTML   ''''''''''''''''
     my_exp = "<td"
     Index = InStr(my_string, my_exp)
     If Index > 0 Then

  Dim jiequ As String
  jiequ = Mid(IE.document.all.tags("html")(0).outerHTML, Index, 200)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''不会用数组，只能这样了，
kaohaoN = InStr(jiequ, ">")
kaohaoM = InStr(jiequ, "/td><td")
Dim kaohao1 As String, kaohao2 As String
kaohao1 = Mid(jiequ, kaohaoN + 10, 165)
kaohao2 = Mid(jiequ, kaohaoN + 1, kaohaoM - 2 - kaohaoN)
Sheet1.Range("c" & n) = kaohao2


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
xingmingN = InStr(kaohao1, "rap")
xingmingM = InStr(kaohao1, "</td><td")
Dim xingming1 As String, xingming2 As String
xingming1 = Mid(kaohao1, xingmingN + 20, 155)
xingming2 = Mid(kaohao1, xingmingN + 13, xingmingM - xingmingN - 13)
Sheet1.Range("d" & n) = xingming2


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
wuwenN = InStr(xingming1, "rap")
wuwenM = InStr(xingming1, "</td><td")
Dim wuwen1 As String, wuwen2 As String
wuwen1 = Mid(xingming1, wuwenN + 20, 135)
wuwen2 = Mid(xingming1, wuwenN + 13, wuwenM - wuwenN - 13)
Sheet1.Range("e" & n) = wuwen2

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
shuN = InStr(wuwen1, "rap")
shuM = InStr(wuwen1, "</td><td")
Dim shu1 As String, shu2 As String
shu1 = Mid(wuwen1, shuN + 20, 120)
shu2 = Mid(wuwen1, shuN + 13, shuM - shuN - 13)
Sheet1.Range("f" & n) = shu2

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
eN = InStr(shu1, "rap")
eM = InStr(shu1, "</td>")
Dim e1 As String, e2 As String
e1 = Mid(shu1, eN + 20, 82)
e2 = Mid(shu1, eN + 13, eM - eN - 13)
Sheet1.Range("g" & n) = e2

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Ln = InStr(e1, "rap")
lM = InStr(e1, "</td><td")
Dim l1 As String, l2 As String
l1 = Mid(e1, Ln + 20, 82)
l2 = Mid(e1, Ln + 13, lM - Ln - 13)
Sheet1.Range("h" & n) = l2


Sheet1.Range("j" & n) = "YES"

     Else
'       MsgBox "出错"
     End If
Else

Sheet1.Range("j" & n) = "NO"
End If

    doc.Close

    Set doc = Nothing

    IE.Quit

    Set IE = Nothing

   Application.Wait (Now + TimeValue("00:00:01"))

Next

    End Sub

qcw911

ie大法

duquancai

IE大法，很厉害。

jjmysjg

谢谢分享，学习了