GetImageURL

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

　　

转载于:https://www.cnblogs.com/nextseven/p/7291764.html