File not found: The file that you're trying to insert is no longer available

[Digby45]

Hi All

An import image code I have used for years has stopped working, It has the error

! File not found: The file that you're trying to insert is no longer available

This hasn't been a problem before, and has been working happily for about 8 years! It doesn't seem to be able to be cancelled out through normal VBA?

Here is my code

>>> use code - tags <<<

Sub Insert_Image()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Sheets("Summary").Select

Dim inputCell As String
Dim outputCell As String
Dim filePath As String
Dim imageHeight As Integer
Dim imageWidth As Integer
Dim stopRow As Integer
Dim X As Range

' Specify the location values
inputCell = "D"            ' The column which has the image names
outputCell = "G"           ' The column you want the picture to go into
imageHeight = 50      ' The width of the image you are inserting
imageWidth = 60      ' The width of the image you are inserting
stopRow = 1500              ' How many rows to look for so that the loop stops.

' Specify when to stop the loop (this is needed as there are spaces between the cells ' so you need to tell excel when to finish and not look forever.

For Each X In Range(inputCell + "1", Range(inputCell & stopRow).End(xlUp))

   ' If the value of the cell is empty move on to the next one.
   If X <> "" Then
       With X.Offset(1, 0)

           ' Set the image output to be the outputcell specified above on the same row.
           Range(outputCell & X.Row).Select

           ' Check to see if the image exists, if not move on and ignore
           On Error Resume Next
        
           If Dir(filePath + X) <> "" Then
               ' If the iamge exists insert the picture.
               ActiveSheet.Pictures.Insert(filePath + X).Select

               ' Once the image is inserted, using the aspect ratio change the width to a specified value
               Selection.ShapeRange.LockAspectRatio = msoTrue
               Selection.ShapeRange.Width = imageWidth
               Selection.ShapeRange.Height = imageHeight
               On Error GoTo 0
            

           End If
           On Error Resume Next
       End With
   End If

NextX:
   Next X



       ActiveSheet.DrawingObjects.Select
    Selection.PrintObject = msoFalse
    Selection.PrintObject = msoTrue
    Selection.Placement = xlMoveAndSize
    Application.CommandBars("Format Object").Visible = False

   Application.ScreenUpdating = False

   Range("B3").Select


  ' ActiveSheet.Pictures.Select

   Dim s As String
Dim pic As Picture
Dim Rng As Range

Set ws = ActiveWorkbook.Worksheets("Summary")
Set Rng = ws.Range("A5:Z5000")

'Sheets("summary").Select

'Dim shp As Shape

'For Each shp In ActiveSheet.Shapes
'If Not shp.Type = msoFormControl Then shp.Delete

'Next
For Each pic In ActiveSheet.Pictures
With pic
s = .TopLeftCell.Address & ":" & .BottomRightCell.Address
End With
If Not Intersect(Rng, ws.Range(s)) Is Nothing Then
pic.ShapeRange.IncrementTop 0.75

pic.ShapeRange.IncrementLeft 0.75


End If
' Next

Dim CellTopLeft As Range

    'For Each pic In ws.Pictures
        With pic
            Set CellTopLeft = .TopLeftCell
            If CellTopLeft.Column <> 7 Then Set CellTopLeft = CellTopLeft.EntireRow.Cells(1, 7)     '*****This statement added
            If Not Intersect(Rng, CellTopLeft) Is Nothing Then
                .Top = (CellTopLeft.Top + CellTopLeft.Height / 2) - .Height / 2
                .Left = (CellTopLeft.Left + CellTopLeft.Width / 2) - .Width / 2
            End If
        End With
      
   Next

  On Error GoTo 0

    
    Range("B2").Select
    Range("F5").Select
    Range("B2").Select
    Application.ScreenUpdating = True
Application.DisplayAlerts =True
  
   End Sub

Appreciate any input as it is driving me crazy!!!

Digby

 

[6StringJazzer]

Have you considered that there is nothing wrong with your code but that the file is simply not found?

Also the variable filePath is used but never set. I have no idea how this ever worked before. It is going to be the null string everywhere it is referenced.

When pasting code please consider marking it as code so it is more readable. This preserves the spacing so we can see the structure. Paste the code, select it, then

 

[Digby45]

 

[Digby45]

Have you considered that there is nothing wrong with your code but that the file is simply not found?

Also the variable filePath is used but never set. I have no idea how this ever worked before. It is going to be the null string everywhere it is referenced.

When pasting code please consider marking it as code so it is more readable. This preserves the spacing so we can see the structure. Paste the code, select it, then
View attachment 78376

Noted thank you, first time user

It has always worked, but after a Windows update I am now getting the error (above image) that I can't code around.
It should move on if no image is found as it always has rather than error message

 

[6StringJazzer]

The variable filePath is never set. What is that intended to be?

Can you describe the setup so I can see if I can reproduce this? What kind of files are these and where are they stored? Where is that relative to where the Excel file is stored?

 

[Digby45]

Hi

Perhaps this code is easier as it is shorter. Essentially the same is occurring here and same message appears if no image is found, where it just returned nothing with no error prior to last weekend.
The images are help on a cloud platform, so it is pulling down from a url

Here is the code

Sub Insert_Image_Checker()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim s As String
Dim pic As Picture
Dim Rng As Range

Set ws = ActiveSheet
Set ws = ActiveWorkbook.Worksheets("Order")

Set Rng = ws.Range("F11:G17")

For Each pic In ActiveSheet.Pictures
With pic
s = .TopLeftCell.Address & ":" & .BottomRightCell.Address
End With
If Not Intersect(Rng, ws.Range(s)) Is Nothing Then
pic.Delete
End If
Next

 Dim picname As String
Dim imageHeight As Integer

 imageHeight = 145
 
On Error Resume Next

 picname = ActiveCell.Offset(0, -4) 'Link to the picture
 ActiveSheet.Pictures.Insert(picname).Select


 With Selection
 .Left = Range("F11").Left
 .Top = Range("F11").Top
 Selection.ShapeRange.LockAspectRatio = msoTrue
               Selection.ShapeRange.Width = imageWidth
               Selection.ShapeRange.Height = imageHeight
              
                   Selection.ShapeRange.IncrementTop 0.75
    Selection.ShapeRange.IncrementTop 0.75
    Selection.ShapeRange.IncrementTop 0.75

 End With

ActiveCell.Select

 Application.ScreenUpdating = True
 Application.DisplayAlerts = True

 End Sub

The code is executed through a private sub where a user moves from one cell to another. It deletes the current image, then brings in the next and so on

 

[Digby45]

As the error doesn't seem to be able to be handled within the VBA, I wonder if the solution would be to check first to see if the return on the image is a 404 error and f so move on?