个人已经尝试了直接在csv中编写对应vb代码有效性，其中有一些前提条件:
1. 数据在第一个表格
[Visual Basic] 纯文本查看 复制代码 Set ws = ThisWorkbook.Sheets(1) ' 假设数据在第一个工作表
2. 数据是从第一行开始的，也就是没有标题数据，若不是可以更改代码中对应数字即可
[Visual Basic] 纯文本查看 复制代码 For i = 1 To lastRow ' 假设数据从第1行开始
接下来是所有代码，可直接在csv文件中运行
[Visual Basic] 纯文本查看 复制代码 Sub DownloadImagesFromCSV()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim folderName As String
Dim imageLinks As String
Dim links() As String
Dim link As String
Dim fileName As String
Dim imgFolderPath As String
Dim currentDir As String
Dim linkIndex As Long
Dim imgPath As String
currentDir = ThisWorkbook.Path
' 当前工作表
Set ws = ThisWorkbook.Sheets(1) ' 假设数据在第一个工作表
' 获取最后一行
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' 遍历每一行数据
For i = 1 To lastRow ' 假设数据从第1行开始
folderName = ws.Cells(i, 3).Value ' 获取 C 列作为文件夹名
imageLinks = ws.Cells(i, 31).Value ' 获取 AE 列作为图片链接
' 如果 AE 列没有图片链接，跳过该行
If Len(Trim(imageLinks)) = 0 Then
GoTo SkipRow
End If
' 分割多个图片链接（以逗号分隔）
links = Split(imageLinks, ",")
' 如果 links 数组没有有效的图片链接，跳过该行
If UBound(links) < 0 Then
GoTo SkipRow
End If
' 创建相对路径的文件夹（如果不存在）
imgFolderPath = currentDir & "\" & folderName
If Dir(imgFolderPath, vbDirectory) = "" Then
MkDir imgFolderPath
End If
' 下载每个图片
For linkIndex = 0 To UBound(links)
link = Trim(links(linkIndex)) ' 获取当前链接
If link <> "" Then
' 获取图片的文件名（从链接中提取）
fileName = Mid(link, InStrRev(link, "/") + 1)
imgPath = imgFolderPath & "\" & fileName
' 调用 DownloadFile 函数来下载图片
Call DownloadFile(link, imgPath)
End If
Next linkIndex
SkipRow:
Next i
MsgBox "图片下载完成！"
End Sub
' 下载文件的函数
Sub DownloadFile(url As String, filePath As String)
Dim httpRequest As Object
Dim byteArray() As Byte
Dim fileNumber As Integer
' 创建 HTTP 请求对象
Set httpRequest = CreateObject("MSXML2.XMLHTTP")
' 发送 GET 请求
httpRequest.Open "GET", url, False
httpRequest.Send
' 检查请求是否成功
If httpRequest.Status = 200 Then
' 获取响应体（二进制数据）
byteArray = httpRequest.responseBody
' 获取文件号
fileNumber = FreeFile
' 打开文件进行写入
Open filePath For Binary Access Write As #fileNumber
' 写入数据
Put #fileNumber, , byteArray
' 关闭文件
Close #fileNumber
Else
MsgBox "下载失败，HTTP 状态码: " & httpRequest.Status, vbCritical
End If
End Sub
| 
发表于 2024-11-23 02:34
|
发表于 2024-11-23 15:21
,
