Add image from file path and put text into next cell if successful

[babybluebentley]

Hi,
I already have a VBA that inserts the corresponding image next to a file path. Works fine so far

Sub AddImageFromPath()
    Dim xRg As Range
    Dim xCell As Range
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.Range("C2:C10000")
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    For Each xCell In xRg
        xVal = xCell.Value
        If xVal <> "" Then
            ActiveSheet.Shapes.AddPicture xCell.Value, msoFalse, msoTrue, _
            xCell.Offset(0, 1).Left, xCell.Top, xCell.Height, _
            xCell.Height
        End If
    Next
    Application.ScreenUpdating = True
End Sub

-> file(image) paths are in column C, images gets added into cell next to path

My problem is: As I generate the image path via a formula, not every file path actually has an image. My tool should actually check whether or not there is an image for this path or not, so I would like to have a TRUE if there is an image and a FALSE if there is no image. I think i makes sense to add this marker next to the image.
I already tried to create a formula to check it, works, but its way to slow and Excel crashed after two hours. This is the code i tired:

Function HASpic(Cell As Range) As Boolean

   Dim Caddress      As String
   Dim Pict          As Object
  
   Application.Volatile
   Caddress = Cell.Address
  
   For Each Pict In Application.Caller.Parent.Pictures
      If Pict.TopLeftCell.Address = Caddress Then
         HASpic = True
         Exit Function
      End If
   Next Pict
   HASpic = False
  
End Function

Now I need a code that combines both and tires to mark if an image got added successfully next to a file path. Alternatively, a code that checks if a file exists with the file path in column C

I would be extremely happy if someone could help.

 

[Fluff]

Not sure why you want True or False in a cell, when you can see if there is an image there or not.

However you can if an image exists or not when you add them, like

Sub AddImageFromPath()
    Dim xRg As Range
    Dim xCell As Range
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.Range("C2:C10000")
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    For Each xCell In xRg
        xVal = xCell.Value
        If xVal <> "" Then
            If Dir(xVal) = "" Then
                xCell.Offset(, 2).Value = False
            Else
                ActiveSheet.Shapes.AddPicture xCell.Value, msoFalse, msoTrue, _
                xCell.Offset(0, 1).Left, xCell.Top, xCell.Height, _
                xCell.Height
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub

 

[babybluebentley]

Not sure why you want True or False in a cell, when you can see if there is an image there or not.

However you can if an image exists or not when you add them, like

Sub AddImageFromPath()
    Dim xRg As Range
    Dim xCell As Range
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.Range("C2:C10000")
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    For Each xCell In xRg
        xVal = xCell.Value
        If xVal <> "" Then
            If Dir(xVal) = "" Then
                xCell.Offset(, 2).Value = False
            Else
                ActiveSheet.Shapes.AddPicture xCell.Value, msoFalse, msoTrue, _
                xCell.Offset(0, 1).Left, xCell.Top, xCell.Height, _
                xCell.Height
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Thank you so much!! Works 100%.
It added and checked 8500 file paths in a matter of seconds, incredible!
I wanted it to be true or false so I can sort out the paths with no image. Way easier this way than doing it one by one.

 

[Fluff]

You're welcome & thanks for the feedback.