Importing JPG, JPEG, and PNG images from a folder to an Excel worksheet

As I am a novice, I was keen to solve the task, so now I want to optimize the code.

Sub AddOlEObject()

Dim mainWorkBook As Workbook

Set mainWorkBook = ActiveWorkbook
Sheets("SingleProfile").Activate
Folderpath = "C:\Users\sandeep.hc\Pics"
Set fso = CreateObject("Scripting.FileSystemObject")
NoOfFiles = fso.GetFolder(Folderpath).Files.Count
Set listfiles = fso.GetFolder(Folderpath).Files
For Each fls In listfiles
strCompFilePath = Folderpath & "\" & Trim(fls.Name)
If strCompFilePath <> "" Then
If (InStr(1, strCompFilePath, "jpg", vbTextCompare) > 1 _
Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 _
Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Then
counter = 29
counter1 = counter1 + 1

Call insert(strCompFilePath, counter, counter1)
'Sheets("SingleProfile").Activate
counter1 = counter1 + 17
End If
End If
Next
mainWorkBook.Save
End Sub

Function insert(PicPath, counter, counter1)
'MsgBox PicPath
With ActiveSheet.Pictures.insert(PicPath)
With .ShapeRange
.LockAspectRatio = msoFalse
.Width = 875
.Height = 300
End With
.Left = ActiveSheet.Cells(counter, counter1).Left
.Top = ActiveSheet.Cells(counter, counter1).Top
.Placement = 1
.PrintObject = True
End With
End Function


Sub AddImage2()
Dim rgTarget As Range
Dim RowI As Long, ColumnI As Long

Folderpath = "C:\Users\sandeep.hc\Pics"
Set fso = CreateObject("Scripting.FileSystemObject")
NoOfFiles = fso.GetFolder(Folderpath).Files.Count
Set listfiles = fso.GetFolder(Folderpath).Files
For Each fls In listfiles
strCompFilePath = Folderpath & "\" & Trim(fls.Name)
If strCompFilePath <> "" Then
If (InStr(1, strCompFilePath, "jpg", vbTextCompare) > 1 _
Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 _
Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Then
RowI = 29
ColumnI = ColumnI + 1
Set rgTarget = Cells(RowI, ColumnI)
Application.ActiveSheet.Shapes.AddPicture strCompFilePath, False, True, rgTarget.Left, rgTarget.Top, 875, 400
ColumnI = ColumnI + 17
End If

End If
Next
End Sub


I will summarize what I said before (and add a few new ones):

• Use Option Explicit at the top of your module. It helps you to prevent mistakes and forces you to declare the variables

• instead of Instr use Right as in If Right(strCompFilePath,4)=".jpg"

• rename counter and counter1 so it is clear what they are (row and column indices)

• Declare insert as a Sub and not a Function.

• instead of passing the row and column index to the insert function/sub and then using the ActiveSheet pass the cell as a Range to the insert function/sub. (Instead of Activesheet you can use cell.Worksheet to get the right sheet)

• possibly rename insert so you don't confuse it with Pictures.insert

• add the option savewithfile := true to the Pictures.Insert method so the pictures will stay in the file even if you send it somewhere.

• as it is now, you don't really need NoOfFiles and mainWorkBook

• instead of the FileSystemObject I would use Dir. See this for more on that.

• Thank you for your detailed help to understand and improve the code i have tried to consider all the points and i have used the method shapes.Addpicture instead of .Insert – sandeep Jun 3 '16 at 11:19

Be sure to avoid things like .Activate - it just slows the code down by needing to fiddle with the spreadsheet while doing everything else behind the scenes. There's a good question on Stack Overflow addressing this.