Vba to create installer like code

Sub CreateShortCut()
Dim oWSH As Object
Dim oShortcut As Object
Dim sPathDeskTop As String
Set oWSH = CreateObject("WScript.Shell")
sPathDeskTop = oWSH.SpecialFolders("Desktop")
Set oShortcut = oWSH.CreateShortCut(sPathDeskTop & "\" & _
ActiveWorkbook.Name & ".lnk")
With oShortcut
.TargetPath = ActiveWorkbook.FullName
.Save
End With
Set oWSH = Nothing
End Sub