EXCELVBAで任意のフォルダ内にある画像をEXCELへ自動で貼り付ける方法を教えてください。

フォルダには複数枚の写真データが入っていますが、ファイル名(jpg)がバラバラです。セルに入力されているデータ名と同じ名前のフォルダがあった場合は、
フォルダ内の写真データをセルに合わせて貼り付ける方法を教えてください。
EXCEL VBAでフルパスで指定するやり方がわかるのですが、写真データの名前が不揃いだと、どうしても初心者でわかりませんでした。またコマンドボタン一つですべて自動で貼りつくようにしたいです。
ご教授宜しくお願いします。
《EXCEL内データ》A列にデータがあります。

A Ｂ Ｃ Ｄ E
１ 14
２ 22
３ 55
・
・

《写真が入っているフォルダ：CドライブのAフォルダ内》
14フォルダ →（010101A.jpg、01011199B.jpg、A201655B.jpg、864156.jpg）
22フォルダ →（20161011.jpg、1122.jpg）
55フォルダ →（12345.jpg）
・
・

↓↓↓

【結果】※EXCEL内データ セルに大きさに合わせてB１、C1、D1・・・と枚数分だけ横に表示
A Ｂ Ｃ Ｄ E
１ 14 010101A 01011199B A201655B 864156
２ 22 20161011 1122
３ 55 12345
・
・
・


宜しくお願いします！！

No.1 ベストアンサー 回答者： jmuiny 回答日時： 2016/12/21 11:00

一例です。

セルの大きさに合わせて添付しますので、セルはそれなりの大きさにしておいて下さい。


Sub Sample()
Dim fpath As String, fname As String
Dim i As Long, j As Long
Application.ScreenUpdating = False
fpath = ”C:\A\" ’CドライブのAフォルダ内という設定
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
j = 1
tmpath = fpath & Range("A" & i).Value & "\"
fname = Dir(tmpath & "*.jpg", vbNormal)
Do Until fname = ""
j = j + 1
With Cells(i, j)
Set shp = ActiveSheet.Shapes.AddPicture(Filename:=tmpath & fname, _
LinkToFile:=False, SaveWithDocument:=True, _
Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
End With
fname = Dir()
Loop
Next i
Application.ScreenUpdating = True
End Sub