|
这节来看下怎样下载网页图片到本地文件。 每一种方法是用API函数URLDownToFile Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Declare Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
Sub testURLDownloadToFile()
Dim nUrl As String, localFilename As String, lngRetVal As Long
nUrl = "http://www.baidu.com/img/baidu_logo.gif"
localFilename = ThisWorkbook.Path & Application.PathSeparator & "myimg.gif"
lngRetVal = URLDownloadToFile(0, nUrl, localFilename, 0, 0)
If lngRetVal = 0 Then
DeleteUrlCacheEntry nUrl '清除缓存
MsgBox "成功"
Else
MsgBox "失败"
End If
End Sub
其中参数nUrl是图片路径，localFilename是保存到本地的完整路径。 也可以用HTTP方法 Sub HttpDownNetFile()
Dim nUrl As String, localFilename As String, i
Dim XmlHttp As Object, ayrHttpBody() As Byte 'For i = 1 To 100
nUrl = "http://www.baidu.com/img/baidu_logo.gif"
localFilename = ThisWorkbook.Path & Application.PathSeparator & i & "1.pdf" Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
XmlHttp.Open "GET", nUrl, True '异步下载
XmlHttp.Send Do Until XmlHttp.ReadyState = 4
DoEvents
Loop If XmlHttp.Status = 200 Then
ayrHttpBody() = XmlHttp.ResponseBody
Open localFilename For Binary As #1
Put #1, , ayrHttpBody()
Close #1
MsgBox "成功"
Else
MsgBox "失败"
End If
'Next
Set XmlHttp = Nothing
End Sub
上面两个代码是下载到本地，也可以将网页图片直接插入表格 Sub 网页图片插入工作表()
Dim target, pic
For Each pic In Sheet1.Shapes
If pic.Type = msoPicture Then
pic.Delete
End If
Next
Sheet1.Pictures.Insert("http://www.baidu.com/img/baidu_logo.gif").Select
Set target = Range("A1:D4")
With Selection
.Top = target.Top + 1
.Left = target.Left + 1
.Width = target.Width - 1
.Height = target.Height - 1
End With
End Sub
也可以将图片插入图形对象中 Sub 插入图形对象()
Dim vcode
Dim nUrl As String, localFilename As String, lngRetVal As Long
nUrl = "http://www.baidu.com/img/baidu_logo.gif"
Set vcode = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 60, 60, 100, 60)
vcode.Select
Selection.ShapeRange.Fill.UserPicture nUrl
End Sub
|
