لعمل اختصار على سطح المكتب
ضع هذا الكود في موديول ثم استدعيه
Public Sub CreateDesktopShortcut(strShortcutTitle As String, _
Optional strTargetPath As String = "")
On Error Resume Next
Dim oShell As IWshShell_Class
Dim oShortcut As IWshShortcut_Class
Dim vItem As Variant
Dim vType As Variant
Set oShell = New IWshShell_Class
If strTargetPath = "" Then
strTargetPath = CurrentDb.Name
End If
For Each vItem In oShell.SpecialFolders
If Mid(vItem, Len(vItem) - 6, 7) = "Desktop" And _
InStr(1, vItem, "All Users") = 0 And _
InStr(1, UCase(vItem), "ADMINISTRATOR") = 0 Then
Set oShortcut = oShell.CreateShortcut(vItem & "\" & strShortcutTitle & ".lnk")
oShortcut.TargetPath = strTargetPath
oShortcut.Save
End If
Next
End Sub
استدعية بهذه الطريقة
Call CreateDesktopShortcut("This is my shortcut title")
حرك الماووس فوق الشريط حتى يتحول شكله لسهمين متعاكسين ثم اضغط واسحب