Getting rid of "An error occurred while importing this file" message pop-up

Zakkair123 · Sep 21, 2016

Hello,

I have the following macro in one of my worksheets and the purpose of it is to acquired images from a REMOTE database when changes are made to cell L7 and W7. It used to work perfectly in Excel 2013 with no error message even if the image does not exist. However, since I updated to Excel 2016, the error box "An error occurred while importing this file" appears everytime an image is missing. I have a loop that checks item numbers in a column if they exist, everytime an image is missing, the same error box would pop up...

Is there a way to adjust my code such that the error messages do not appear?

Thanks!

Code:

'Activate Add_Photo_Move sub whenever cell L7 or W7 is changed.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("L7")) Is Nothing Then Sheet8.Add_Photo_Move
  If Not Intersect(Target, Range("W7")) Is Nothing Then Sheet8.Add_Photo_Move
End Sub

Sub Add_Photo_Move()
  Dim i As Double
  Dim xPhoto As String
  Dim sLocT As String
  Dim Item As String
  Dim sPattern As String
  Dim oPic As Shape, allpic As String
  Dim oP As String, ac As Integer, c, t
  Dim Pic As Object
  
  i = 11
  
start_time = Now()
  
sLocT = "C:\Program Files (x86)\REMOTE\CompressedImages\"
  
Item = Range("H" & i)
sPattern = sLocT & Item & "*.jpg"

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False


For Each Pic In ActiveSheet.Pictures
  If Pic.Name <> "PNG" Then
  Pic.Delete
  End If
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Next Pic
  
On Error Resume Next
  
Do While Item <> ""
  xPhoto = Dir(sPattern, vbNormal)
  Range("G" & i).Select
  
  With ActiveSheet.Pictures.Insert(sLocT & xPhoto)
  .Left = Range("G" & i).Left
  .Top = Range("G" & i).Top
  .Height = 60#
  .Width = 100#
  End With


  Range("H" & i).Select
  ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
  Address:=sLocT & xPhoto, TextToDisplay:=xPhoto
  xPhoto = Dir
  
  i = i + 1
  Item = Range("H" & i)
  sPattern = sLocT & Item & "*.jpg"
  
Loop
  
Application.EnableEvents = True
Application.ScreenUpdating = True
  
End Sub

Hui · Sep 22, 2016

Zakkair

Firstly, Welcome to the Chandoo.org Forums

If the code is running except when there is a missing picture, why not capture that with an error trap and then handle it as appropriate

using

Code:

On error resume next

before the offending line, results in VBA skipping over the error and carrying on
But then you need to allow for what is missing in subsequent code

Zakkair123 · Sep 22, 2016

Hui said:
Zakkair

Firstly, Welcome to the Chandoo.org Forums

If the code is running except when there is a missing picture, why not capture that with an error trap and then handle it as appropriate

using

Code:

On error resume next

before the offending line, results in VBA skipping over the error and carrying on
But then you need to allow for what is missing in subsequent code

Hi Hui,

Thanks for the reply. Greatly appreciate it. Would I be required to encode the On Error Resume Next code within the while loop? I'm slightly confused on where to put my error trap in the vba code.

Thanks again.

Hui · Sep 22, 2016

Put the above line just before where it is crashing now

But then just after that you have to allow for what ever is causing the error, ie: a Blank File name etc

Without knowing where the error was its hard to be more specific

Can you post a sample file ?

Zakkair123 · Sep 22, 2016

Hui said:
Put the above line just before where it is crashing now

But then just after that you have to allow for what ever is causing the error, ie: a Blank File name etc

Without knowing where the error was its hard to be more specific

Can you post a sample file ?

Hi Hui,

I have posted a sample file here. The Macro is on the play button and it looks up cells C2:C6 (whenever the SKU number runs out) and returns images in cells B2:B6 with the image hyperlink address in cell A2:A6.

However, if an image is not found, I get the error "An error occurred while importing this file. C:\Program Files (x86)\REMOTE\CompressedImages". All I need is for this message to not pop up. The results should remain the same.

Thanks again.

Hui · Sep 23, 2016

You had the On Error in the wrong location

try:

Code:

Sub Add_Photo_Move()
Dim i As Double
Dim xPhoto As String
Dim sLocT As String
Dim Item As String
Dim sPattern As String
Dim oPic As Shape, allpic As String
Dim oP As String, ac As Integer, c, t

i = 2

start_time = Now()

sLocT = "C:\Program Files (x86)\REMOTE\CompressedImages\"

Item = Range("C" & i).Text
sPattern = sLocT & Item & "*.jpg"
Application.EnableEvents = False
Application.ScreenUpdating = False

Do While Item <> ""
  xPhoto = Dir(sPattern, vbNormal)
  Range("B" & i).Select
   
  On Error Resume Next
  With ActiveSheet.Pictures.Insert(sLocT & xPhoto)
  .Left = Range("B" & i).Left
  .Top = Range("B" & i).Top
  .Height = 50#
  .Width = 50#
  End With
   
  'Range ("A" & i)
  ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & i), _
  Address:=sLocT & xPhoto, _
  TextToDisplay:=xPhoto
   
  i = i + 1
  Item = Range("C" & i)
  sPattern = sLocT & Item & "*.jpg"

Loop

end_time = Now()

MsgBox (" All done and run took  " & DateDiff("s", start_time, end_time) & "sec")

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Hui · Sep 23, 2016

Here is the code tidied up a bit

Code:

Sub Add_Photo_Move()

Dim xPhoto As String
Dim sLocT As String
Dim Item As String
Dim sPattern As String
Dim LR As Integer
Dim c As Range

Application.EnableEvents = False
Application.ScreenUpdating = False

start_time = Now()

sLocT = "'C:\Program Files (x86)\REMOTE\CompressedImages\"

LR = Range("C" & Rows.Count).End(xlUp).Row

For Each c In Range("C2:C" + CStr(LR))

  sPattern = sLocT & c.Text & "*.jpg"

  xPhoto = Dir(sPattern, vbNormal)
  Range("B" & c.Row).Select
 
  On Error Resume Next
  With ActiveSheet.Pictures.Insert(sLocT & xPhoto)
  .Left = Range("B1").Left
  .Top = Range("B" & c.Row).Top
  .Height = 50#
  .Width = 50#
  End With
 
  ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & c.Row), _
  Address:=sLocT & xPhoto, _
  TextToDisplay:=xPhoto

Next c

end_time = Now()

Application.EnableEvents = True
Application.ScreenUpdating = True

MsgBox ("All done and run took  " & CStr(Int(end_time - start_time)) & " sec")

End Sub

Zakkair123 · Sep 23, 2016

Hi Hui,

Really appreciate you simplifying the code. I am however still getting the pop-up message "An Error Occurred while importing this file. C:\Program Files..." whenever an image is not found.

Thanks.

Hui · Sep 23, 2016

It works ok for me
Can you post the file?

Zakkair123 · Sep 23, 2016

Here you go

Hui · Sep 23, 2016

Please try this:

Code:

Sub Add_Photo_Move()


Dim sLocT As String
Dim Item As String
Dim sPattern As String
Dim LR As Integer
Dim c As Range


Application.EnableEvents = False
Application.ScreenUpdating = False

 'start_Time = Now()

 sLocT = "C:\Program Files (x86)\REMOTE\CompressedImages\"

 LR = Range("C" & Rows.Count).End(xlUp).Row

For Each c In Range("C2:C" + CStr(LR))

  sPattern = sLocT & c.Text & ".jpg"

  Range("B" & c.Row).Select
 
  On Error Resume Next
  With ActiveSheet.Pictures.Insert(sPattern)
  .Left = Range("B1").Left
  .Top = Range("B" & c.Row).Top
  .Height = 50#
  .Width = 50#
  End With
 
  ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & c.Row), _
  Address:=sLocT & xPhoto, _
  TextToDisplay:=xPhoto

Next c

 'end_time = Now()

 Application.EnableEvents = True
 Application.ScreenUpdating = True


End Sub

Zakkair123 · Sep 23, 2016

Hui said:

Please try this:

Code:

Sub Add_Photo_Move()


Dim sLocT As String
Dim Item As String
Dim sPattern As String
Dim LR As Integer
Dim c As Range


Application.EnableEvents = False
Application.ScreenUpdating = False

'start_Time = Now()

sLocT = "C:\Program Files (x86)\REMOTE\CompressedImages\"

LR = Range("C" & Rows.Count).End(xlUp).Row

For Each c In Range("C2:C" + CStr(LR))

  sPattern = sLocT & c.Text & ".jpg"

  Range("B" & c.Row).Select

  On Error Resume Next
  With ActiveSheet.Pictures.Insert(sPattern)
  .Left = Range("B1").Left
  .Top = Range("B" & c.Row).Top
  .Height = 50#
  .Width = 50#
  End With

  ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & c.Row), _
  Address:=sLocT & xPhoto, _
  TextToDisplay:=xPhoto

Next c

'end_time = Now()

Application.EnableEvents = True
Application.ScreenUpdating = True


End Sub

Thank you so much Hui. The code works perfectly. I added another simple line of code to remove the previous images whenever the VBA runs and they integrate perfectly :D

Hui · Sep 23, 2016

You also need to change the line from
xPhoto to SPattern

It should be:

Code:

  ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & c.Row), _
  Address:=sPattern, _
  TextToDisplay:=sPattern

Digby45 · Apr 6, 2022

Hi Hui

I am having the same issue as above which must be from a recent update. I have tried adapting the code above but no luck. Can you help me please? 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 <<<

Code:

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

vletm · Apr 6, 2022

Digby45
This thread is over five years old.
You should open a new thread
as written in Forum Rules:

Site Rules - New Users - Please Read

Hi all, Welcome to the Chandoo.org Forums. Posting Rules & Etiquette The Chandoo.org Forums is a collaborative and happy place to learn and expand your Excel knowledge. The Chandoo.org Forums consist of several Sub-Forums based on the type of question/area of Excel you are interested in...

chandoo.org

This thread is closed now.

Getting rid of "An error occurred while importing this file" message pop-up

Zakkair123

New Member

Hui

Excel Ninja

Zakkair123

New Member

Hui

Excel Ninja

Zakkair123

New Member

Attachments

Hui

Excel Ninja

Hui

Excel Ninja

Zakkair123

New Member

Hui

Excel Ninja

Zakkair123

New Member

Attachments

Hui

Excel Ninja

Zakkair123

New Member

Hui

Excel Ninja

Digby45

New Member

vletm

Excel Ninja

Site Rules - New Users - Please Read