Scribd
Upload
33 views

Load Multiple Objects in Excel

This macro inserts objects from files in a selected folder into the active worksheet. It uses the FileSystemObject to get a reference to the selected folder, then loops through all files in that folder. For each file, it inserts the file path into the current cell and adds the file as an OLE object with an icon. It offsets to the next row before each iteration.

Uploaded by

amanda05700
Copyright
© © All Rights Reserved
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
33 views

Load Multiple Objects in Excel

This macro inserts objects from files in a selected folder into the active worksheet. It uses the FileSystemObject to get a reference to the selected folder, then loops through all files in that folder. For each file, it inserts the file path into the current cell and adds the file as an OLE object with an icon. It offsets to the next row before each iteration.

Uploaded by

amanda05700
Copyright
© © All Rights Reserved
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 1

Sub Insert_Objects()

'
' Insert_Objects Macro
'
' Keyboard Shortcut: Ctrl+Shift+O
'
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim ws As Worksheet
Dim MyRow As Integer
Dim MyCol As Integer
Dim CurrentFile As String

Set objFSO = CreateObject("Scripting.FileSystemObject")


Set ws = ThisWorkbook.ActiveSheet

'Get the folder object associated with the directory

Set objFolder = Application.FileDialog(msoFileDialogFolderPicker)


With objFolder
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem

Set objFolder = objFSO.GetFolder(sItem)


'Loop through the Files collection
MyRow = ActiveCell.Row
MyCol = ActiveCell.Column
For Each objFile In objFolder.Files
ws.Cells(MyRow, MyCol).Value = objFolder & "\" & objFile.Name

CurrentFile = ws.Cells(MyRow, MyCol).Value


ActiveSheet.OLEObjects.Add(Filename:= _
CurrentFile, Link:= _
False, DisplayAsIcon:=True, IconFileName:= _
"C:\WINDOWS\system32\packager.dll", IconIndex:=0, IconLabel:="").Select
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 0)).Select

Next

'Clean up!
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
End Sub

You might also like