VBA-Excel: Add/Insert multiple objects from a folder in an Excel Document.

To Add or Insert Multiple objects from a folder in Microsoft Excel, you need to follow the steps below:

  • Create the object of FileSystemObject(Link)
  • Create Folder object using FileSystemObject and GetFolder (link) method and count the number of files.
  • Get the files Object
  • Run the Loop for each files in folder
  • Insert the File objects , using OLE objects.
  • Insert the added files name list in another sheet(just for reference)
  • Save the workbook


Create the object of FileSystemObject

Set fso = CreateObject(“Scripting.FileSystemObject”)

Create Folder object using FileSystemObject and GetFolder  method and count the number of files.

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

Get the files Object

Set listfiles = fso.GetFolder(Folderpath).Files

Run the Loop for each files in folder

For Each fls In listfiles

strCompFilePath = Folderpath & “\” & Trim(fls.Name)

Insert the File objects , using OLE objects.

ActiveSheet.OLEObjects.Add(Filename:=strCompFilePath, Link:= _

False, DisplayAsIcon:=True, IconIndex:=1, IconLabel:=strCompFilePath).Select

Sheets(“Object”).Activate

Sheets(“Object”).Range(“B” & ((Counter – 1) * 3) + 1).Select

Insert the added files name list in another sheet(just for reference)

Range(“A” & Counter).Value = fls.Name

Save the workbook

mainWorkBook.Save

 

Complete Code:

Sub AddOlEObject()

Dim mainWorkBook As Workbook

Set mainWorkBook = ActiveWorkbook

Folderpath = "D:\Insert"

Set fso = CreateObject("Scripting.FileSystemObject")

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

    Set listfiles = fso.GetFolder(Folderpath).Files

    For Each fls In listfiles

        Counter = Counter + 1

        Range("A" & Counter).Value = fls.Name

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

        If strCompFilePath <> "" Then

            ActiveSheet.OLEObjects.Add(Filename:=strCompFilePath, Link:= _

                False, DisplayAsIcon:=True, IconIndex:=1, IconLabel:=strCompFilePath).Select

                Sheets("Object").Activate

            Sheets("Object").Range("B" & ((Counter - 1) * 3) + 1).Select

        End If

    Next

mainWorkBook.Save

End Sub
Insert OLE Object-1
Insert OLE Object-1
Insert OLE Object-2
Insert OLE Object-2