a picture web Address goes to different place

[drom]

Hi and Thanks in advance!


I few days ago I posted the following question:

MyPreviousMrExcelquestion​

Already solved​

​

now I am having a different problem:

I am trying to isert a picture in a cell (like in my previous question)
The picture exists:

• https://casdocs.com/CASAS/01758-97.JPG
• Picture

But I do not know why when I copy and paste the previous address in google the previous address becomes:

https://casdocs.com/CASAS/01758-79.jpg

So When I am trying to get the picture from the website using the macro (I get the err 1004, because the picture does not exit with the 97 address

Sub mToInsertURLpicture()
  On Error Resume Next:                         Application.ScreenUpdating = False
Dim WKBvba As Workbook:                         Set WKBvba = ThisWorkbook
Dim WKBactive As Workbook:                      Set WKBactive = ActiveWorkbook
  Dim wActSht As String:                        wActSht = ActiveSheet.Name
    Dim rCell As Range:                         Set rCell = ActiveCell
Dim wURL As String:                             wURL = rCell
  Dim Pic As Picture
Dim Shp As Shape

    wURL = "https://casdocs.com/CASAS/01758-97.jpg"

    Err.Clear

    'rCell.Select

    If wURL <> "" Then
      If Left(LCase(wURL), 4) = "http" Then '://" Or Left(LCase(wURL), 8) = "https://" Then
        Err.Clear
        Set Pic = Nothing: Set Pic = Sheets(wActSht).Pictures.Insert(wURL)
        If Pic Is Nothing Then
          Set Pic = Nothing: Set Pic = Sheets(wActSht).Pictures.Insert(UCase(wURL))
        End If
        If Pic Is Nothing Then
          Set Pic = Nothing: Set Pic = Sheets(wActSht).Pictures.Insert(Left(LCase(wURL), Len(wURL) - 4) & UCase(Right(wURL, 4)))
        End If
        If Pic Is Nothing Then
          MsgBox "Wrong" & vbNewLine, vbCritical, "Thanks in advance!"
        Else
          MsgBox "OK" & vbNewLine, vbInformation, "Thanks in advance!"
        End If
      End If
    End If

End Sub

How can I solve this??

 

[Domenic]

Your code will need to check whether the location has moved. If so, it will need to retrieve the new location. Therefore, first add the following function to your code module...

Private Function url_redirected(ByRef url As String, ByRef location As String, ByRef status_code As Long) As Boolean

    Dim req As Object
    Set req = CreateObject("WinHttp.WinHttpRequest.5.1")
   
    With req
        .option(6) = False 'No redirects
        .Open "GET", url, False
        .send
        If .status = 301 Or .status = 302 Then 'moved or re-directed
            location = .getResponseHeader("Location")
            status_code = .status
            url_redirected = True
            Exit Function
        End If
    End With
   
    url_redirected = False

End Function

Then replace the following line...

wURL = "https://casdocs.com/CASAS/01758-97.jpg"

with

    wURL = "https://casdocs.com/CASAS/01758-97.jpg"
   
    Dim location As String
    Dim status_code As Long
    If url_redirected(wURL, location, status_code) = True Then
        wURL = location
    End If

Hope this helps!