Insert all image in folder into Excel using VBA

' Funtion to get name of root folder
Function getNameFolder()
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    If fd.Show = -1 Then
        getNameFolder = fd.SelectedItems(1)
    Else
        getNameFolder = ""
    End If
End Function

'main handling...
Sub Main()
    'Declare variables for folders
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objSubFolder As Object

    'Declare variables for File
    Dim objFolderFile As Object
    Dim objFile As Object
    Dim ws As Worksheet
 
    Dim pic As Picture
    'Declare variables for format image when insert
    Dim i As Long
    Dim width As Long
    Dim height As Long
    'Declare variables for path initinal
    Dim path As String
    path = getNameFolder
    Application.ScreenUpdating = False
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Get the folder object
    Set objFolder = objFSO.GetFolder(path)
    'loops through each file in the directory and prints their names and path
    For Each objSubFolder In objFolder.subfolders
        'Declare variables for default format initial
        i = 20
   
        'add new sheet
        With ThisWorkbook
            Set ws = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
        End With
   
        'Get the folder object
        'Set name for sheet
        ws.Name = "IMP_" & objSubFolder.Name
     
        Range("A1") = "Test ID:"
        Range("B1") = "IMP_" & objSubFolder.Name
     
        Set objFolderFile = objFSO.GetFolder(objSubFolder.path)
            For Each objFile In objFolderFile.Files
         
                Set pic = ActiveSheet.Pictures.Insert(objFile.path)
                pic.Select
                'Selection.ShapeRange.IncrementTop i
                ' Scale images after insert by 100%
                Selection.ShapeRange.ScaleWidth 1, msoTrue
                Selection.ShapeRange.ScaleHeight 1, msoTrue
             
                width = Selection.ShapeRange.width
                height = Selection.ShapeRange.height
                pic.Delete
                Application.ActiveSheet.Shapes.AddPicture objFile.path, False, True, 50, i, width, height
                i = i + height + 20
             
                Application.ActiveSheet.Shapes.AddPicture "D:\a.jpg", False, True, (width / 2), i, 75, 75
             
                i = i + 75 + 20
            Next objFile
     
        ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Select
        Selection.Delete
     
     
        Range("A1").Select
    Next objSubFolder
 
    Application.ScreenUpdating = True
End Sub