请问这个vba图片抓取代码能否抓取超过30张以上图片

hipsonwong

Sub DownloadPictures()
     Dim strkey As String
     Dim strURL As String
     Dim strFolderPath As String
     Dim strText As String
     Dim strPicPath As String
     Dim strPicURL As String
     Dim strExtName As String
     Dim aPageNum As Variant
     Dim aExtName As Variant
     Dim i As Long
     Dim k As Long
     strFolderPath = ThisWorkbook.Path & "\" & [b2].Value & "\"
     If Dir(strFolderPath, vbDirectory + vbHidden) > "" Then
     Else
         MkDir strFolderPath
     End If
     strkey = [b2].Value
     If Len(strkey) = 0 Then
         MsgBox "未输入查询关键字，程序退出。"
         Exit Sub
     End If
     strkey = encodeURI(strkey) '对查询关键字转码
     With CreateObject("msxml2.xmlhttp") '发送网页请求，获得响应信息
         strURL = "http://image.baidu.com/search/index?tn=baiduimage&word=" & strkey
         .Open "GET", strURL, "False"
         .send
         strText = .responseText
     End With
     aPageNum = Split(strText, """pageNum"":")
     '按关键字pageNum对响应信息进行拆分
     For i = 1 To UBound(aPageNum)
         If InStr(1, aPageNum(i), "objURL", vbTextCompare) Then
         '判断是否存在字符串objurl
             k = k + 1
             strPicURL = Split(Split(aPageNum(i), """objURL"":""")(1), """,")(0)
             '图片的网址
             aExtName = Split(strPicURL, ".")
             strExtName = "." & aExtName(UBound(aExtName))
             '图片的后缀名
             strPicPath = strFolderPath & k & strExtName
             '图片保存地址
             DeleteUrlCacheEntry strPicURL
             '删除图片缓存数据
             URLDownloadToFile 0, strPicURL, strPicPath, 0, 0
             '下载图片
         End If
         End sub

vbee

自己试试就知道了