用VBA下载google图片

ccwan · 发表于 2009-12-11 15:54

篇外话：我是2006年911注册的会员（只是巧合，并非有意），但是实际在线时间有限。在这里，看到了很多的牛人，

我从各位版主、会员等达人那里学到了很多，尽管我不可能学得很深入，毕竟我不是专业人士，甚至也没有上过大学，但我依然觉得自己有了很大的进步，在此感谢各位。

言归正传

经过搜索，没有发现有用vba下载google图片的帖子（或者是我没找到？），于是便凑了点代码，和大家分享。已经加上了注释，便于新手理解。
千万不要嫌下载速度慢哦，IE嘛。要快的话，还是用下载软件的好。

Sub cc()
Dim s, ss(), r%, i&, j&
IName = "刘亦菲" '这里确定要下载谁的图片
Path = ThisWorkbook.Path & ""
MkDir Path & IName '建立文件夹以便存放图片
On Error Resume Next
Set ie = CreateObject("Msxml2.XMLHTTP")
For r = 0 To 100 Step 20 '这里控制你要下载几张网页的图片 _
—如果你定的数字很大，那么恭喜你，你可以休息很长时间了，呵呵
ie.Open "GET", "http://images.google.cn/images?gbv=2&hl=zh-CN&newwindow=1&q=" & IName & "&sa=N&start=" & r & "&ndsp=20"", true"
ie.Send
Do Until ie.ReadyState = 4
DoEvents
Loop '等待网页处理完成再运行下面的代码
s = Split(ie.responseText, """") '把源文件中的引号替换成换行，以便提取图片链接
For i = 0 To UBound(s)
If s(i) Like "http://*" Then
If InStr(s(i), "jpg") Then '这里两行查找含有图片地址的链接
j = j + 1
ReDim Preserve ss(1 To j)
ss(j) = s(i) '把含有图片地址的链接址传递给数组ss
End If
End If
Next
Next
For i = 1 To UBound(ss)
ie.Open "GET", ss(i), False
ie.Send
Do Until ie.ReadyState = 4
DoEvents
Loop
With CreateObject("ADODB.Stream")
.Type = 1
.Open
.write ie.Responsebody
.savetofile Path & i & ".jpg", 2 '以序号为名称另存图片
.Close
End With
Name Path & i & ".jpg" As Path & IName & "" & i & ".jpg" '把下载下来的图片移到文件夹中
Next
End Sub

复制代码

[ 本帖最后由 ccwan 于 2009-12-11 15:56 编辑 ]

ericfei · 发表于 2009-12-11 16:01

踩下，留个脚印。

xibeiakang · 发表于 2009-12-11 16:35

技术很好，创意很好。支持你

lb_bn · 发表于 2009-12-11 16:46

楼主高人啊，学习。

ccwan · 发表于 2009-12-11 16:59

lb_bn兄谬赞了，看到兄这些天的回复，就知我比你差得远呢。

飞云楼主 · 发表于 2009-12-11 17:08

支持一下，收下学习。

lb_bn · 发表于 2009-12-11 17:11

客气了，ccwan老师的功力比我高很多。

northwolves · 发表于 2009-12-11 23:19

已知图片地址,可使用API:URLDownloadToFile 进行下载,GOOGLE搜之

Moneky · 发表于 2009-12-12 01:21

刚刚酒完就来学习了，谢谢！后面肯定会用到的，先留个脚印，谢谢分享！

ccwan · 发表于 2009-12-12 07:16

原帖由 northwolves 于 2009-12-11 23:19 发表
已知图片地址,可使用API:URLDownloadToFile 进行下载,GOOGLE搜之

多谢狼版指教。我去搜搜看

		自动登录	找回密码
密码			免费注册

[分享] 用VBA下载google图片

评分

回复 5楼 ccwan 的帖子