Multi Embedding - icons names & Sizes

[CondeMontecristo]

Hi all,

I was in need of a macro that embedded multiple files and I eventually got it. However, I need to resize the icons and get their names (file name / source name), as none of the names are shown but only blank icons. Although I thought I had captured this pieace in the code below, obviously I did not. Can anyone please give me a hand? I am struggling with the code and cannot find it out.

Sub Multiple_Embedding()


Dim mainWorkBook As Workbook
Dim flder As FileDialog
Dim folderpath As String
Set mainWorkBook = ActiveWorkbook
Set fso = CreateObject("Scripting.FileSystemObject")
Set flder = Application.FileDialog(msoFileDialogFolderPicker)


With flder
.Title = "Please select the folder where the files you wish to embed are saved into"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
folderpath = .SelectedItems(1)
End With


NextCode:
ChooseFolder = folderpath
Set flder = Nothing


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


Set listfiles = fso.GetFolder(folderpath).Files

On Error Resume Next




For Each fls In listfiles


Counter = Counter + 1


strCompFilePath = folderpath & "" & fls.Name


If strCompFilePath <> "" Then


ActiveSheet.OLEObjects.Add(Filename:=strCompFilePath, Link:= _
False, DisplayAsIcon:=True, IconIndex:=1, IconLabel:=strCompFilePath).Select


Sheets("Sheet1").Activate


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

Else

Dim OleObj As OLEObjects
ActiveSheet.OLEObjects.Select
OleObj.ShapeRange.LockAspectRatio = msoFalse
OleObj.Height = 50
OleObj.Width = 50


End If


Next


mainWorkBook.Save


End Sub