Multi Embedding - icons names & Sizes

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

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").Range("B" & ((Counter - 1) * 3) + 1).Select


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

End If



End Sub

Some videos you may like

This Week's Hot Topics

  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • find many based on a certain criteria
    good evening, I hope someone can help me? I have a workbook sheet 2 contains lots of data.... I would like to be able to find anything on sheet...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
  • Text Format
    I have a sheet for user to keyin the data. The format of the data can be 451 / 1903, 0012 / 9908 or 00287 / 0099. The number after the "/" is...
  • Macro to copy values across rows and transposing them and add the user id
    [FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]Hi,[/COLOR][/SIZE][/FONT] [FONT=Times New...