1,502
社区成员
发帖
与我相关
我的任务
分享
Sub GetOptionLinksByRegex()
Dim URL As String
Dim PageHtml As String
Dim X
Dim j As Integer
Dim objRegex As Object
Dim c As Object
On Error Resume Next
URL = "http://www.english-schools.org/"
Set myXmlHttp = CreateObject("msxml2.XMLHTTP")
With myXmlHttp
.Open "GET", URL, False
.send
PageHtml = .responsetext
j = 1
Set objRegex = CreateObject("VBScript.RegExp")
objRegex.ignorecase = True
objRegex.Global = True
objRegex.Pattern = "[\r\n]\s*" '不能直接设置multiline,否则会丢失几个信息
PageHtml = objRegex.Replace(PageHtml, "") '只能手工替换
objRegex.Pattern = "option value\=""(.+?)""\>(.+?)\<\/option"
Set X = objRegex.Execute(PageHtml)
For Each c In X
Debug.Print j & ")URL=" & c.submatches(0) & ";Country=" & c.submatches(1)
j = j + 1
Next
End With
Set myXmlHttp = Nothing
End Sub
Sub GetOptionLinks()
Dim URL As String
Dim PageHtml As String
Dim X
Dim s As String
Dim i As Integer, j As Integer
On Error Resume Next
URL = "http://www.english-schools.org/"
Set myXmlHttp = CreateObject("msxml2.XMLHTTP")
With myXmlHttp
.Open "GET", URL, False
.send
PageHtml = .responsetext
X = Split(PageHtml, "option")
j = 1
For i = 6 To UBound(X) Step 2
s = X(i)
mypos = InStr(s, ">")
Debug.Print j & ")URL='" & Mid(s, 9, mypos - 10) & "';Country=" & Mid(s, mypos + 1, Len(s) - mypos - 2)
If Err.Number = 0 Then
j = j + 1
Else
Err.Clear
End If
Next
End With
Set myXmlHttp = Nothing
End Sub
Dim vTag As Object
Dim i As Integer
Set vTag = WebBrowser1.Document.links
For i = 0 To vTag.length - 1
If InStr(vTag(i).href, "schools.org") > 0 Then
Me.Print vTag(i).href
End If
Next
Option Explicit
Private Sub Form_Load()
WebBrowser1.Navigate "http://www.english-schools.org/"
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim obj As Object
If URL <> "http://www.english-schools.org/" Then Exit Sub
For Each obj In WebBrowser1.Document.All.tags("Option")
Debug.Print obj.Value
Next
End Sub