Macro for insert picture

Hello,
Please help
i have to insert item pictures in column A i have item code in column B. All pictures saved in D drive folder name pictures. filname start with code number but other information like size also written in file name.Below macro works fine if i have file name only as code number.
i want modiffication in this macro so it will insert pictures which file name start with "item code" but ignore later part of file name.(code*.jpg).

Thanks


Sub Picture()
Dim picname As String

Dim pasteAt As Integer
Dim lThisRow As Long

lThisRow = 2

Do While (Cells(lThisRow, 2) <> "")


pasteAt = lThisRow
Cells(pasteAt, 1).Select 'This is where picture will be inserted


picname = Cells(lThisRow, 2) 'This is the picture name

present = Dir("C:\Users\Administrator\Desktop\LC\" & picname & ".jpg")

If present <> "" Then

ActiveSheet.Pictures.Insert("C:\Users\Administrator\Desktop\LC\" & picname & ".jpg").Select 'Path to where pictures are stored
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
'.Left = Range("A6").Left
'.Top = Range("A6").Top
.Left = Cells(pasteAt, 1).Left
.Top = Cells(pasteAt, 1).Top

.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100#
.ShapeRange.Width = 130#
.ShapeRange.Rotation = 0#
End With



Else
Cells(pasteAt, 1) = "No Picture Found"
End If

lThisRow = lThisRow + 1
Loop

Range("A10").Select
Application.ScreenUpdating = True

Exit Sub

ErrNoPhoto:
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub
Range("B20").Select

End Sub