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
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
VBA Code:
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