Hi all,

Although I am a registered user for more than a year ago now, this is my first post, so please bear with me if I make any mistakes while laying out my issue (I read the rules though so hopefully I will not...).

I was in need of a macro that embedded multiple files and I got it, eventually. However, I need to resize the icons/files emdebbed and keep their source/file names, as the icons/files are embedded with large sizes and none of the names are shown either but only blank icons/files...

Although I thought I had captured this piece in the code below, obviously I did not. Could anyone please give me a hand? I am struggling with the code for the days now and cannot figure it out... I will appreciate any input. 

 
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 & "\" & Trim(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

        End If

    Next

mainWorkBook.Save

End Sub

Icons size
Sub Test()
Dim OleObj As OLEObject

    Set OleObj = ActiveSheet.OLEObjects(1)     ' embedded PDF A4 ... not icon
    OleObj.ShapeRange.LockAspectRatio = msoFalse
    OleObj.Height = 30
    OleObj.Width = 30

End Sub
Tested wit a PDF originally A4 size ... one doesn't have to like the final look ;-)
If you want to maintain the aspect ratio but still want to fit your OLEObject into a 30x30 grid, you need to apply one single setting to the larger dimension, e.g.
' ....

If OleObj.Width > OleObj.Height Then
    OleObj.Width = 30
Else
    OleObj.Height = 30
End If
Thank you very much.