Need show NOT FOUND msg in image column if image not found.

[pgujju143]

Dear All,

I have macro to insert images again cell reference folder as well subfolder .

we need show error in column which is not put images again cell references

Means if image not found i want to show msg in image cell (not found)

thanks in advance

Dim aryFolders() As Variant
Dim intFlexibleFolders As Long


Sub InstanciateFolders()
'Set up the array to be used. Place the default location as the first location
    intFlexibleFolders = 2
    ReDim aryFolders(1 To 2)
    aryFolders(1) = "D:\images"
End Sub
Sub BuildFolders()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim i As Integer, strHoldMe As String
    Call InstanciateFolders
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Get the folder object
    Set objFolder = objFSO.GetFolder("D:\images")
    i = 1
    'loops through each file in the directory and prints their names and path
    For Each objSubFolder In objFolder.subfolders
        ReDim Preserve aryFolders(1 To intFlexibleFolders)
        strHoldMe = objSubFolder.Path
        aryFolders(intFlexibleFolders) = strHoldMe
        intFlexibleFolders = intFlexibleFolders + 1
    Next objSubFolder
End Sub
Sub InsertImage_Click()
    On Error Resume Next
    Dim strFilePath As String, strFilePathandName As String, rngFileNameSource As Range
    Dim Shp As Shape
    Dim rngPicture As Range
    Dim rngCell As Range, strDirectoryName As String
    Call BuildFolders
    For i = 1 To UBound(aryFolders)
        strFilePath = aryFolders(i) & "\"
        Set rngFileNameSource = Range("B2", Cells(Rows.Count, "B").End(xlUp))
        'Loop through range of file names to get the name of the file
        For Each rngCell In rngFileNameSource
            'Set the full file name and path
            'Add .jpg extenstion if missing
            If Left(rngCell.Value, 4) <> ".jpg" Then
                strFilePathandName = strFilePath & rngCell.Value & ".jpg"
            Else
                strFilePathandName = strFilePath & rngCell.Value
            End If
            'Load the directory of the file
            strDirectoryName = Dir(strFilePathandName)
            'If file is in directory then move picture into file
            If strDirectoryName <> "" Then
                Set rngPicture = rngCell.Offset(1, 0)
                Set Shp = ActiveSheet.Shapes.AddPicture(Filename:=strFilePathandName _
                        , LinkToFile:=False, SaveWithDocument:=True, Left:=rngPicture.Left, Top:=rngPicture.Top _
                        , Width:=rngPicture.Width, Height:=rngPicture.Height)
                Shp.Height = 100
                If Shp.Height > 409 Then
                    rngCell.EntireRow.RowHeight = 409
                Else
                    rngCell.EntireRow.RowHeight = Shp.Height
                End If
                Shp.Left = rngCell.Left
                Shp.Top = rngCell.Top
            End If
        Next
        DoEvents
    Next
    MsgBox ("Insert Images done")
End Sub

 

[DKaur]

Have you tried putting in an error handler, something like:

Sub InsertImage_Click()
On Error GoTo NoImage
//YOUR CODE//
Next i
Exit Sub
NoImage:
Cells(n, m) = "No image available" //SET N AND M TO BE THE CELLS YOU WANT TO ENTER THE MESSAGE IN
Resume Next
End Sub

 

[pgujju143]

Thanks Dkaur but getting error while running this code please suggest,

Error like
Run-Time error '1004:
application defined or object defined error

 

[DKaur]

Can you paste your whole code again, and also let me know which line is causing the error?

 

[pgujju143]

Dim aryFolders() As Variant
Dim intFlexibleFolders As Long


Sub InstanciateFolders()
'Set up the array to be used. Place the default location as the first location
intFlexibleFolders = 2
ReDim aryFolders(1 To 2)
aryFolders(1) = "\\10.0.3.10\Images\GILI\Group_Brand_MIX"
End Sub
Sub BuildFolders()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim i As Integer, strHoldMe As String
Call InstanciateFolders
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("\\10.0.3.10\Images\GILI\Group_Brand_MIX")
i = 1
'loops through each file in the directory and prints their names and path
For Each objSubFolder In objFolder.subfolders
ReDim Preserve aryFolders(1 To intFlexibleFolders)
strHoldMe = objSubFolder.Path
aryFolders(intFlexibleFolders) = strHoldMe
intFlexibleFolders = intFlexibleFolders + 1
Next objSubFolder
End Sub
Sub InsertImage_Click()
On Error GoTo NoImage
Dim strFilePath As String, strFilePathandName As String, rngFileNameSource As Range
Dim Shp As Shape
Dim rngPicture As Range
Dim rngCell As Range, strDirectoryName As String
Call BuildFolders
For i = 1 To UBound(aryFolders)
strFilePath = aryFolders(i) & "\"
Set rngFileNameSource = Range("B2", Cells(Rows.Count, "B").End(xlUp))
'Loop through range of file names to get the name of the file
For Each rngCell In rngFileNameSource
'Set the full file name and path
'Add .jpg extenstion if missing
If Left(rngCell.Value, 4) <> ".jpg" Then
strFilePathandName = strFilePath & rngCell.Value & ".jpg"
Else
strFilePathandName = strFilePath & rngCell.Value
End If
'Load the directory of the file
strDirectoryName = Dir(strFilePathandName)
'If file is in directory then move picture into file
If strDirectoryName <> "" Then
Set rngPicture = rngCell.Offset(1, 0)
Set Shp = ActiveSheet.Shapes.AddPicture(Filename:=strFilePathandName _
, LinkToFile:=False, SaveWithDocument:=True, Left:=rngPicture.Left, Top:=rngPicture.Top _
, Width:=rngPicture.Width, Height:=rngPicture.Height)
Shp.Height = 100
If Shp.Height > 409 Then
rngCell.EntireRow.RowHeight = 409
Else
rngCell.EntireRow.RowHeight = Shp.Height
End If
Shp.Left = rngCell.Left
Shp.Top = rngCell.Top
End If
Next
DoEvents
Next i
Exit Sub
NoImage:
Cells(n, m) = "No image available" '//SET N AND M TO BE THE CELLS YOU WANT TO ENTER THE MESSAGE IN
Resume Next


'Next
'MsgBox ("Insert Images done")

End Sub

 

[DKaur]

Hi, sorry for the late reply.
You need to assign values to n and m. At some point in your code.

 

[pgujju143]

Hi Dear,

I am sorry but i can't understand what you say please if possible explain more.