Sub GetImageUrl(ByVal URL As String) Dim strText As String Dim i As Long Dim OneImg With CreateObject("MSXML2.XMLHTTP") .Open "GET", URL, False .Send strText = .responsetext End With Dim arr() As String ReDim arr(1 To 1) As String With CreateObject("htmlfile") .write strText i = 0 For Each OneImg In .getElementsByTagName("img") If OneImg.getAttribute("real_src") <> "Null" Then ‘If RegTest(CStr(OneImg.getAttribute("real_src")), "http(.+)sinaimg\.cn/(.+)") Then Debug.Print RegTest(OneImg.getAttribute("real_src"), "http://s\d+?(.+)sinaimg\.cn/(.+)") Debug.Print OneImg.getAttribute("real_src") ‘ End If End If Next End With End Sub Sub ddddddddd() GetImageUrl "http://blog.sina.com.cn/s/blog_5a18c50f0102x8lg.html" End Sub Sub dd() Debug.Print RegTest("http://s14.sinaimg.cn/mw690/001Eip7Fzy7d3ZOIfKZfd&690", "http(.+)sinaimg\.cn/(.+)") End Sub Public Function RegTest(ByVal OrgText As String, ByVal Pattern As String) As Boolean ‘传递参数 :原字符串, 匹配模式 Dim Regex As Object Set Regex = CreateObject("VBScript.RegExp") With Regex .Global = True .Pattern = Pattern End With RegTest = Regex.TEST(OrgText) Set Regex = Nothing End Function
时间: 2024-10-14 20:17:55