将图像从Web提取到Excel

Question

我正试图从我订阅的网站中提取一张图片，该网站会生成每天更新的图形。

我的代码使用querySelector和getAttribute来提取我想要导入Excel的图形。

问题是我的代码无法获取src地址。我相信我的html引用是正确的。

html来源：

<img class="chart-img" style="max-height: 150px;" alt="Chart ID 2669" 
src="https://website.com/c/422/charts/ClearChart_2054_128978589342.jpg" diagnostic- 
id="chart-img-1" chart-id="2669">`

我当前的代码

Sub ImportImage()
Dim IE As Object
Dim HTMLDoc As Object
Dim HTMLImg As Object
Dim strURL As String

strURL = "https://website.com/chartbooks/22920"

Set IE = CreateObject("InternetExplorer.Application")

With IE
.Visible = True
.navigate strURL
Do While .Busy Or .readyState <> 4 '4 = READYSTATE_COMPLETE
DoEvents
Loop
Set HTMLDoc = .document
End With

On Error Resume Next
Set HTMLImg = HTMLDoc.querySelector("img[alt='Chart ID 2669']")
On Error GoTo 0

With Worksheets("Sheet1").Range("A1")
If Not HTMLImg Is Nothing Then
.Picture = HTMLImg.getAttribute("src")
Else
.Value = "Image not found"
End If
End With

Set IE = Nothing
Set HTMLDoc = Nothing
Set HTMLImg = Nothing

End Sub

Answer 1

您需要将图像插入工作表，而不是单元格。将图像插入图纸后，可以使用其他代码来操作图像的位置和大小。

请尝试下面的代码。

Sub ImportImage()
Dim IE As Object
Dim HTMLDoc As Object
Dim HTMLImg As Object
Dim strURL As String

strURL = "https://website.com/chartbooks/22920"

Set IE = CreateObject("InternetExplorer.Application")

With IE
.Visible = True ' do you really need IE visible ?
.navigate strURL
Do While .Busy Or .readyState <> 4 '4 = READYSTATE_COMPLETE
DoEvents
Loop
Set HTMLDoc = .document
End With

On Error Resume Next        

Set HTMLImg = HTMLDoc.querySelector("img[alt='Chart ID 2669']")

On Error GoTo 0

With Worksheets("Sheet1")
If Not HTMLImg Is Nothing Then
' Insert the picture into the sheet, not the cell
.Pictures.Insert (HTMLImg.getAttribute("src"))
Else
.Range("A1").Value = "Image not found"
End If
End With

Set IE = Nothing
Set HTMLDoc = Nothing
Set HTMLImg = Nothing

End Sub