VBA 怎样批量下载网页图片？

quqiyuan · 发表于 2024-8-12 07:13

前面的那几个库需要安装一下

tspliu · 发表于 2024-8-12 09:22

我一般下载文件用下面这段，忘记哪个大佬提供的了
Sub requestimage(picurl$, picname$) '图片url,图片名称
Dim brr() As Byte
With CreateObject("msxml2.serverxmlhttp")
            .Open "get", picurl, False
            .send
            Do Until .Status = 304 Or .Status = 200
                  DoEvents
                  If Timer - t >= 5 Then
                     brr = ""
                     GoTo 1
                  End If
            Loop
                  brr = .Responsebody
1:

         WriteImage ThisWorkbook.path, brr, picname
End With
End Sub
Private Sub WriteImage(path$, arr() As Byte, index$)
With CreateObject("scripting.filesystemobject")
      If Not .FolderExists(path & "\mm") Then '假设保存在mm文件夹中
         .createfolder (path & "\mm")
      End If
End With
Open path & "\mm\" & Replace(index, "/", "\", , , vbBinaryCompare) For Binary As #1
Put #1, , arr
Close #1
End Sub

cai2532 · 发表于 2024-8-12 09:48

留下脚印学习了。

MR_PP · 发表于 2024-8-12 10:19

本帖最后由 MR_PP 于 2024-8-12 10:59 编辑

[code][/code]

MR_PP · 发表于 2024-8-12 10:30

Sub ToPDF()
Dim http As Object
Dim html As Object
Dim imgTags As Object
Dim imgTag As Object
Dim imgUrl As String
Dim folderPath As String
Dim fileName As String
Dim i As Integer
Dim wdApp As Object
Dim wdDoc As Object
' 设置保存图片的文件夹路径
folderPath = ThisWorkbook.path & "\mm" ' 请更改为你的文件夹路径
If Right(folderPath, 1) <> "" Then folderPath = folderPath & ""
' 创建HTTP和HTML对象
Set http = CreateObject("MSXML2.XMLHTTP")
Set html = CreateObject("HTMLFile")
' 请求网页
http.Open "GET", "https://tieba.baidu.com/p/1909682384", False
http.send
' 将响应加载到HTML对象中
html.body.innerHTML = http.responseText
' 获取所有图片标签
Set imgTags = html.getElementsByTagName("img")
' 初始化计数器
i = 0
' 遍历每个图片标签并下载图片
For Each imgTag In imgTags
imgUrl = imgTag.src
' 检查URL是否有效
If imgUrl <> "" Then
On Error Resume Next
' 生成文件名
fileName = folderPath & "Image" & i & ".jpg" ' 可以根据需要修改文件名格式
' 下载图片
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", imgUrl, False
.send
If .Status = 200 Then
Dim stream As Object
Set stream = CreateObject("ADODB.Stream")
stream.Type = 1 ' 二进制数据
stream.Open
stream.Write .responseBody
stream.SaveToFile fileName, 2 ' 保存文件
stream.Close
End If
End With
i = i + 1
On Error GoTo 0
End If
Next imgTag
On Error Resume Next
' 创建Word应用程序和文档
Set wdApp = CreateObject("Word.Application")
Set wdDoc = wdApp.Documents.Add
' 插入下载的图片到Word文档
For j = 0 To i - 1
fileName = folderPath & "Image" & j & ".jpg"
wdDoc.InlineShapes.AddPicture fileName
wdDoc.Content.InsertParagraphAfter ' 插入段落以分隔图片
Next j
' 导出为PDF
wdDoc.SaveAs2 folderPath & "DownloadedImages.pdf", 17 ' 17代表PDF格式
wdDoc.Close
wdApp.Quit
MsgBox "下载完成，共下载了 " & i & " 张图片，并导出为PDF！", vbInformation
End Sub

复制代码

lss001 · 发表于 2024-8-12 14:23

Sub WebImageGrabber()
Dim xml As Object, html As Object
On Error Resume Next
Set xml = CreateObject("MSXML2.XMLHTTP")
xml.Open "GET", "https://tieba.baidu.com/p/1909682384", False
xml.send '请求

Set html = CreateObject("HtmlFile")
html.body.innerHTML = xml.responseText
With ActiveDocument '添加
      For Each img In html.images
         .InlineShapes.AddPicture img.src
      Next
End With

Set xml = Nothing '释放
Set html = Nothing
End Sub

dongdonggege · 发表于 2024-8-12 17:18

tspliu 发表于 2024-8-12 09:22
我一般下载文件用下面这段，忘记哪个大佬提供的了
Sub requestimage(picurl$, picname$) '图片url,图片名 ...

老师，你好，今天开会学习，刚到家。你的函数不会用，麻烦你发个完整的程序，谢谢。

tspliu · 发表于 2024-8-12 17:23

dongdonggege 发表于 2024-8-12 17:18
老师，你好，今天开会学习，刚到家。你的函数不会用，麻烦你发个完整的程序，谢谢。

sub aa()
requestimage url , picname
endsub

dongdonggege · 发表于 2024-8-12 17:26

tspliu 发表于 2024-8-12 17:23
sub aa()
requestimage url , picname
endsub

你的URL哪来的，而且图片的网址，有的前面是https,有点是about，你怎么处理？有的是jpg图片，有的是png图片，怎么处理？特别是网址前面是about，处理错误，结果一个文件都没下载下来。

tspliu · 发表于 2024-8-12 19:43

本帖最后由 tspliu 于 2024-8-12 19:45 编辑

dongdonggege 发表于 2024-8-12 17:26
你的URL哪来的，而且图片的网址，有的前面是https,有点是about，你怎么处理？有的是jpg图片，有的是png图 ...

那你不是不会下载图片，是不会基础的网爬和字符串处理。。。。

我也不太帮得了你，我只会修修改改，红圈的这种就是url，正则啥的方法都可以提取

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

[求助] VBA 怎样批量下载网页图片？