下面这段代码使用的是internet control控件,不知道我说错没有。
只能下载IMG链接的图片,不能下载带有background的图片,请问各位大大,怎么修改代码才能下载到BACKGROUND代码呢?Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Const CF_HDROP = 15Dim oWin As SHDocVw.ShellWindows
Dim oIE As SHDocVw.InternetExplorerDim i As Integer
Dim iOldIndex As IntegerPrivate Sub ListAllImages() '在列表框lstIMG中列出选中IE窗口中所有的<IMG>标签指向的图片
'On Error Resume Next
    Dim bytData() As Byte
    Dim oIMG, oRange
    Dim hMem As Long
    Dim lpData As Long
    Dim lClipSize As Long
    Dim sFileName As String
    Dim colURL As Collection
    Dim colDomain As Collection
    Set colURL = New Collection
    Set colDomain = New Collection
    Dim sDomain
    Dim backg
    
    lstIMG.Clear
    lstDomain.Clear
    lstIMG.ColumnCount = 3
    i = 0
    oIE.Document.ExecCommand ("Unselect")    
    For Each oIMG In oIE.Document.getelementsbytagname("img")
        '从图片的src中提取出域名,赋给sDomain变量
        sDomain = oIMG.src
        sDomain = Mid(sDomain, InStr(sDomain, "//") + 2)
       ' sDomain = Left(sDomain, InStr(sDomain, "/") - 1)
        '通过collection对象去除重复字符串
        On Error Resume Next
        colDomain.Add sDomain, sDomain
        
            
                   ' sDomain = Left(sDomain, InStr(sDomain, "/") - 1)
        '通过collection对象去除重复字符串
        On Error GoTo 0
        
        '通过ExecCommand可以复制IE中的图片,之后在剪贴板中找到CF_HDROP格式对应的数据即是该图片在本地电脑Internet临时文件夹中缓存文件的完整路径
        Set oRange = oIE.Document.body.createControlRange()
        oRange.Add (oIMG)
        oRange.ExecCommand ("Copy")
        If OpenClipboard(ByVal 0&) <> 0 Then        '打开剪贴板
            hMem = GetClipboardData(CF_HDROP)       '获取剪贴板中CF_HDROP格式数据对应的内存对象句柄
            If CBool(hMem) Then
                lpData = GlobalLock(hMem) + 20      '获取第一个有效数据在内存中的位置
                lClipSize = GlobalSize(hMem) - 20   '获取有效数据的字节长度
                ReDim bytData(0 To lClipSize - 1) As Byte
                CopyMemory bytData(0), ByVal lpData, lClipSize  '复制数据到字节数组
                GlobalUnlock (hMem)
                
                '将字节数组转化为字符串后赋给sFileName字符串变量,这里得到的sFileName即是本地缓存图片文件的完整路径
                '通常会是X:\....\Temporary Internet Files\logo[1].gif这样的形式
                sFileName = StrConv(bytData, vbUnicode)
                
                '通过Collection去掉重复的图片文件
                On Error Resume Next
                Err.Clear
                colURL.Add oIMG.src, oIMG.src
                If Err.Number = 0 Then
                    '在lstIMG列表框的第一列填写图片文件名(不包含路径)
                    lstIMG.AddItem Mid(oIMG.src, InStrRev(oIMG.src, "/") + 1)
                    '在lstIMG列表框的第二列填写图片文件完整的网络路径,如http://...../logo.gif
                    lstIMG.List(i, 1) = oIMG.src
                    '在lstIMG列表框的第三列填写图片文件在本地电脑上的缓存文件(包括完整路径)
                    lstIMG.List(i, 2) = sFileName
 
                    i = i + 1
                End If
                On Error GoTo 0
            End If
            CloseClipboard          '关闭剪贴板
        End If
        Set oRange = Nothing
    Next
    AutoFit lstIMG
    For i = 1 To colDomain.Count
        lstDomain.AddItem colDomain.Item(i)
    Next
    Set colDomain = Nothing
    Set colURL = Nothing
End Sub