insert multiple Images using macro

Sub AddOlEObject()
    Dim mainWorkBook As Workbook
    Dim Folderpath As String
    Dim fso, NoOfFiles, listfiles, fls, strCompFilePath
    Dim counter

    Set mainWorkBook = ActiveWorkbook
    Sheets("Sheet1").Activate
    Folderpath = "your_path_here"   '<-- Change path to your images here
    Set fso = CreateObject("Scripting.FileSystemObject")
    NoOfFiles = fso.GetFolder(Folderpath).Files.Count
    Set listfiles = fso.GetFolder(Folderpath).Files
    For Each fls In listfiles
       strCompFilePath = Folderpath & "\" & Trim(fls.Name)
        If strCompFilePath <> "" Then
            '// include image extensions here \\
            If (InStr(1, strCompFilePath, "jpg", vbTextCompare) > 1 _
            Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 _
            Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Then
                counter = counter + 1
                Sheets("Sheet1").Range("B" & counter).ColumnWidth = 25
                Sheets("Sheet1").Range("B" & counter).RowHeight = 100
                Sheets("Sheet1").Range("B" & counter).Activate
                Call insert(strCompFilePath, counter)
                Sheets("Sheet1").Activate
            End If
        End If
    Next
'mainWorkBook.Save
End Sub

Function insert(PicPath, counter)
    With ActiveSheet.Pictures.insert(PicPath)
    '// change image sizes here \\
        With .ShapeRange
            .LockAspectRatio = msoTrue
            .Width = 50
            .Height = 70
        End With
        .Left = ActiveSheet.Range("B" & counter).Left
        .Top = ActiveSheet.Range("B" & counter).Top
        .Placement = 1
        .PrintObject = True
    End With
End Function