Hello YasserKhalil*,

Further to your reply to my thread "Re: How to insert > 137 no. pictures in excel file?" dated 4 Feb 16 as below,
the following VBA can apply to all jpeg in folder "F:\PIC".

Please advise how to revise the VBA so that it can apply to all jpeg to all sub-folder in "F:\PIC".
(as there are also jpegs in subfolders)





Sub AddOlEObject()
Dim folderPath As String, strCompFilePath As String
Dim FSO, FLS, listFiles
Dim noOfFiles As Long, Counter As Long
Dim mainWorkBook As Workbook
Dim Sh As Worksheet

Set mainWorkBook = ActiveWorkbook
Set Sh = mainWorkBook.Sheets("Sheet1")

Sh.Activate
folderPath = "F:\PIC"
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 = Counter + 1
Sh.Range("A" & Counter).Value = FLS.Name
Sh.Range("B" & Counter).Activate
Call Insert(strCompFilePath, Counter)
Sh.Activate
End If
End If
Next FLS
End Sub

Function Insert(PicPath, Counter)
Dim R As Range, Sh As Shape

Set R = ActiveSheet.Range("A" & Counter)
Set Sh = ActiveSheet.Shapes.AddPicture(Filename:=PicPath, LinkToFile:=msoFalse, SaveWithDocument:=msoCTrue, Left:=R.Left, Top:=R.Top, Width:=R.Width, Height:=R.Height)

With Sh
.Top = R.Top
.Left = R.Left
.Height = R.RowHeight
.Placement = xlMoveAndSize
End With
End Function