我已经用vba编写了一个脚本,可以从torrent网站下载不同的电影海报,并将它们嵌入到电子表格中与该电影有关的旁边。我的脚本可以解析电子表格中的电影名称,并将图像下载并保存在文件夹中。我无法做的是将下载的图像放在电子表格中每个电影名称的旁边。
如何在每个电影名称旁边的相关单元格中放置电影海报?
到目前为止,我的脚本是
Sub DownloadAndEmbedImages()
'customized directory location within double quotes
Const strPath$ = "C:\Users\WCS\Desktop\Test\"
Dim Http As New XMLHTTP60, Html As New HTMLDocument
Dim post As Object, imgArr As Variant, R&
'check out if the folder is empty. If not empty, delete them to download anew
If Dir(strPath & "*.*") <> "" Then Kill strPath & "*.*"
With Http
.Open "GET", "https://yts.am/browse-movies", False
.send
Html.body.innerHTML = .responseText
End With
For Each post In Html.getElementsByClassName("img-responsive")
R = R + 1: Sheets("Sheet1").Cells(R, 1) = post.alt
imgArr = Split(post.src, "/")
imgArr = imgArr(UBound(imgArr) - 1) & ".jpg"
Http.Open "GET", post.src, False
Http.send
With CreateObject("ADODB.Stream")
.Open
.Type = 1
.write Http.responseBody
.SaveToFile (strPath & imgArr)
.Close
End With
Next post
End Sub
添加添加以执行上述脚本:
Microsoft XML, v6.0
Microsoft HTML Object library