Need error handler

[pgujju143]

Hi,

I have macro to insert images for folder and sub folders but getting some problem using this we want error handler if image not insert in column show text "No image found" and also want coding for image properties "move and size with cell, lock aspect ratio

Thanks in advance please help me resolve this.
-------------------------------------------------------------------------------------

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.1.4.1\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.1.4.1\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 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

 

[mrmmickle1]

Basic Error Handling works like this:

Error Handling In VBA

You can use syntax like this:

[COLOR=#0000ff]Sub [/COLOR]Test()
[COLOR=#0000ff]On Error GoTo [/COLOR]ErrHandler

[COLOR=#008000]'Code[/COLOR]
[COLOR=#008000]
'Reset Error Handling[/COLOR]
[COLOR=#0000ff]On Error GoTo 0[/COLOR]
[COLOR=#0000ff]Exit Sub
[/COLOR]
ErrHandler:

[COLOR=#0000ff]If [/COLOR]Err.Number <> 0 [COLOR=#0000ff]Then[/COLOR]
MsgBox "You have an error your image is not correct"
[COLOR=#0000ff]End If [/COLOR]
[COLOR=#0000ff]On Error GoTo[/COLOR] -1: [COLOR=#0000ff]On Error GoTo[/COLOR] 0: Err.Clear

[COLOR=#0000ff]End Sub[/COLOR]

 

[pgujju143]

HI thanks mrmmickle1
but above coding not work with including my coding.