How To Extract This Image From The Web

[Maury1704]

Hello everyone from Maurizio
My problem is this:
On an Excel sheet I am downloading all the Weather data from a Web page including the Type images (Img)
And so far so good.
But I would like to be able to download an image (Dl) classified as (i)
I'm trying them all but I'm not going back
You would kindly be able to help me understand where I'm wrong.
Thanks

Sub Previsioni_Tabella()
On Error Resume Next

Dim CollA As Object, CollB As Object
Dim cSrc As String, cIW As Single
Dim IE

X = Foglio1.Range("G1").Value & ""
Y = Foglio1.Range("I1").Value & ""
'
myURL = "https://www.worldweatheronline.com/" & X & "/" & Y & "" & "/it.aspx#pills-tomorrow"
Set IE = CreateObject("internetExplorer.Application")
'
With IE
    .navigate myURL
    .Visible = False                    'meglio TRUE
'    .Visible = True
    Do While .Busy: DoEvents: Loop
    Do While .readyState <> 4: DoEvents: Loop
End With

Do
    DoEvents
    If Timer > myStart + 2 Or Timer < myStart Then Exit Do
Loop
'
'Importa la tabella "10 Day Weather Forecast"
rbase = "A38"                                                    '<<< Dove scrivere
Set CollA = IE.document.getElementBydd("col-4")     'id della tabella
Call RangeClear(Range(rbase).Resize(12, 9))                     'Cancella contenuto della tabella
'col-4
'wi-moon-first-quarter
Set CollB = CollA.getElementsBydl("row")
ccnt = 99: j = 0
On Error Resume Next
For I = 0 To CollB.Length - 1
    ccl = CollB(I).className
    If InStr(1, "ZcZc" & ccl, "col-sm-12", vbTextCompare) > 0 Or ccnt < 8 Then
        If InStr(1, "ZcZc" & ccl, "col-sm-12", vbTextCompare) > 0 Then ccnt = 0: j = j + 1
        If InStr(1, "ZcZc" & ccl, "col-sm-12", vbTextCompare) = 0 Then
            Range(rbase).Offset(j - 1, ccnt).Value = CollB(I).innerText
            cSrc = "": cIW = 0
            cSrc = CollB(I).getElementsByTagName("img")(0).getAttribute("src")
            If cSrc <> "" Then
                Call GetShapeFromWeb("https:" & cSrc, Range(rbase).Offset(j - 1, ccnt))
                cIW = ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Width
                With Range(rbase).Offset(j - 1, ccnt)
                    .ColumnWidth = 10
                    .ColumnWidth = cIW / .Width * 10
                    .EntireRow.RowHeight = cIW
                End With
            End If
            ccnt = ccnt + 1
        End If
    End If
Next I
On Error GoTo 0

'Chiusura IE
IE.Quit
Set IE = Nothing

'Call Weather_Immagini
End Sub

Sub RangeClear(ByRef myRan As Range)
Dim Shp As Shape
'
myRan.ClearContents
myRan.EntireRow.AutoFit
For Each Shp In ActiveSheet.Shapes
    If Shp.Type = msoPicture Or Shp.Type = msoLinkedPicture Then
        If Not Application.Intersect(Shp.TopLeftCell, myRan) Is Nothing Then
            Shp.Delete
        End If
    End If
Next Shp
End Sub

 

[Dan_W]

Hi. I assume you have you have API Url. You can use the code set out here to download an image from the web and insert it into excel - Post in thread 'Insert Image from Website - unable to get insert property of image' Insert Image from Website - unable to get insert property of image

 

[Maury1704]

Hello Dan_W
In the coming days I will study it very much in demand and I will see to make the most of what you offer
Thanks again for everything Greetings from A.Maurizio