سلام الان که من این جواب رو میدم شاید خیلی دیر باشه ولی شاید بعد از این افراد دیگری به این جواب نیاز داشته باشن اول لایبراری "Microsoft Shell Controls and Automation." رو به برنامتون اظافه کنید
Picture1.png
Picture2.jpg
و سپس کد زیر را اظافه کنید و همراه یک آبجکت دکمه
Private Sub CommandButton1_Click()
Dim a As String, b As String, c As String, d As String, e As String
a = ""
b = ""
c = ""
d = ""
e = ""
GetShortcutInfo "C:\Users\15584\Desktop\JPEG Imager 2.lnk", a, b, c, d, e
MsgBox a + "|" + b + "|" + c + "|" + d + "|" + e
End Sub
Private Function GetShortcutInfo(ByVal full_name As String, _
ByRef name As String, ByRef path As String, ByVal descr _
As String, ByRef working_dir As String, ByRef args As _
String) As String
Dim shl As Shell32.Shell
Dim shortcut_path, shortcut_name As String
Dim shortcut_folder As Shell32.Folder
Dim folder_item As Shell32.FolderItem
Dim lnk As Shell32.ShellLinkObject
On Error GoTo GetShortcutInfoError
' Make a Shell object.
Set shl = New Shell32.Shell
' Get the shortcut's folder and name.
shortcut_path = Left$(full_name, InStrRev(full_name, _
"\"))
shortcut_name = Mid$(full_name, InStrRev(full_name, _
"\") + 1)
If Not Right$(shortcut_name, 4) = ".lnk" Then _
shortcut_name = shortcut_name & ".lnk"
' Get the shortcut's folder.
Set shortcut_folder = shl.Namespace(shortcut_path)
' Get the shortcut's file.
Set folder_item = _
shortcut_folder.Items.Item(shortcut_name)
If folder_item Is Nothing Then
GetShortcutInfo = "Cannot find shortcut file '" & _
full_name & "'"
ElseIf Not folder_item.IsLink Then
' It's not a link.
GetShortcutInfo = "File '" & full_name & "' isn't a " & _
"shortcut."
Else
' Display the shortcut's information.
Set lnk = folder_item.GetLink
name = folder_item.name
descr = lnk.Description
path = lnk.path
working_dir = lnk.WorkingDirectory
args = lnk.Arguments
GetShortcutInfo = ""
End If
Exit Function
GetShortcutInfoError:
GetShortcutInfo = Err.Description
End Function
اینم یه فایل با vba
http://s6.picofile.com/file/82659632...heet.xlsm.html