Excel-VBA : Insert Multiple Images from a Folder to Excel Cells

Say you have many images in a folder and you want to insert all these images in your excel work book, one image in one cell. You can do it manually, insert and resize the image and drag it to the particular cell, but think of a scenario where you have more than 100 images or may be more. I am sure you don’t want to do it manually. IF you are looking for solutions for problems like this, this is the tutorial for you.

This tutorial will teach you about how to insert multiple images from a folder into your excel.

Steps:

  • Open a folder(which contains images) using “Scripting.FileSystemObject”.
  • Get the files in it.
  • Make a loop for all the files
  • Check If files name contains “jpg”, “jpeg”, “gif” (You can add more),
  • Activate and resize the cell where you want to insert your image.
  • call Insert function by providing the complete path and cell number.
  • In Insert function, call ActiveSheet.Pictures.insert(piture path).
  • resize the image and set it to the specified cell.

Open a folder(which contains images) using “ Scripting.FileSystemObject”.

Folderpath = "C:\Users\Sumit Jain\Pictures"

Set fso = CreateObject("Scripting.FileSystemObject")

NoOfFiles = fso.GetFolder(Folderpath).Files.Count

Get the files in it.

Set listfiles = fso.GetFolder(Folderpath).Files

Make a loop for all the files

For Each fls In listfiles

Check If files name contains “jpg”, “jpeg”, “gif” (You can add more),

If (InStr(1, strCompFilePath, "jpg", vbTextCompare) > 1 Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Then

Activate and resize the cell where you want to insert your image.

Sheets("Object").Range("A" & counter).Value = fls.Name

Sheets("Object").Range("B" & counter).ColumnWidth = 25

Sheets("Object").Range("B" & counter).RowHeight = 100

Sheets("Object").Range("B" & counter).Activate

Call Insert function by providing the complete path and cell number.

strCompFilePath = Folderpath & "\" & Trim(fls.Name)

Call insert(strCompFilePath, counter)

In Insert function, call ActiveSheet.Pictures.insert(piture path).

ActiveSheet.Pictures.insert(PicPath)

resize the image and set it to the specified cell.

With .ShapeRange

.LockAspectRatio = msoTrue

.Width = 50

.Height = 70

End With

.Left = ActiveSheet.Range("B" & counter).Left

.Top = ActiveSheet.Range("B" & counter).Top

.Placement = 1

.PrintObject = True

Complete Code:

Sub AddOlEObject()
Dim mainWorkBook As Workbook
Set mainWorkBook = ActiveWorkbook
Sheets("Object").Activate
Folderpath = "C:\Users\Sumit Jain\Pictures"
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
Sheets("Object").Range("A" & counter).Value = fls.Name
Sheets("Object").Range("B" & counter).ColumnWidth = 25
Sheets("Object").Range("B" & counter).RowHeight = 100
Sheets("Object").Range("B" & counter).Activate
Call insert(strCompFilePath, counter)
Sheets("Object").Activate
End If
End If
Next
mainWorkBook.Save
End Sub
Function insert(PicPath, counter)
‘MsgBox PicPath
With ActiveSheet.Pictures.insert(PicPath)
With .ShapeRange
.LockAspectRatio = msoTrue
.Width = 50
.Height = 70
End With
.Left = ActiveSheet.Range("B" & counter).Left
.Top = ActiveSheet.Range("B" & counter).Top
.Placement = 1
.PrintObject = True
End With
End Function

view raw
insertImage.vb
hosted with ❤ by GitHub

Insert Multiple Images from a Folder to Excel Cells
Insert Multiple Images from a Folder to Excel Cells