16-09-18, 10:43 PM (آخر تعديل لهذه المشاركة : 17-09-18, 01:25 AM {2} بواسطة DOX.1.)
السـلام عليكم روحمة الله وبركاته
عندي أستفسـار عندي برنامج يعمل على جهاز
محتاج أن البرنامج يبحث عن المجلدات الموجوده في ( Users) وينشأ لكل مجلد أختصار للبرنامج يعني شورت كت في سطح المكتب اللي عنده
17-09-18, 01:16 AM (آخر تعديل لهذه المشاركة : 17-09-18, 07:50 AM {2} بواسطة asemshahen5.)
تفضل جرب هذا الكود بعد إضافة المكتبة الموجودة بالمرفقات .
كود :
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim DIR_FOLDER As String = Application.StartupPath
SORCUT_FOR_ME("Desktop", "\برنامج العاصم للمحاسبة و المستودعات.lnk", DIR_FOLDER & "\AlAsemForAccountingNewVersion.exe" _
, DIR_FOLDER & "THEMS\ICON\ASEM.ICO", "برنامج العاصم للمحاسبة و المستودعات")
End Sub
Private Sub SORCUT_FOR_ME(ByVal SHORCUT_PLEASE As String, ByVal CreateShortcut1 As String, ByVal TargetPath1 As String _
, ByVal IconLocation1 As String, ByVal Description1 As String)
'-----------------------------------------------------------
Dim wshshell As New IWshRuntimeLibrary.WshShell
Dim desktop_PTH As String = CType(wshshell.SpecialFolders.Item(SHORCUT_PLEASE), String)
Dim shortcut_file As IWshRuntimeLibrary.IWshShortcut
shortcut_file = CType(wshshell.CreateShortcut(desktop_PTH & CreateShortcut1), IWshRuntimeLibrary.IWshShortcut)
shortcut_file.TargetPath = TargetPath1
shortcut_file.WindowStyle = 2
shortcut_file.IconLocation = IconLocation1
shortcut_file.Description = Description1
If CreateShortcut1 = "\إلغاء تنصيب برنامج العاصم للمحاسبة و المستودعات.lnk" Then
shortcut_file.WorkingDirectory = "C:\windows\"
Else
shortcut_file.WorkingDirectory = DIR_FOLDER
End If
shortcut_file.Save()
'-----------------------------------------------------------
End Sub
إذا كنت تريد وضع إختصار في قائمة إبدأ ضع الكود التالي :
كود :
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim DIR_FOLDER As String = Application.StartupPath
SORCUT_FOR_ME("Programs", "\برنامج العاصم للمحاسبة و المستودعات.lnk", DIR_FOLDER & "\AlAsemForAccountingNewVersion.exe" _
, DIR_FOLDER & "THEMS\ICON\ASEM.ICO", "برنامج العاصم للمحاسبة و المستودعات")
End Sub
سبحان الله وبحمده سبحان الله العظيم و الحمد لله ولا اله الا الله والله اكبر
Private Function CreateShortCut(ByVal TargetName As String, ByVal ShortCutPath As String, ByVal ShortCutName As String) As Boolean
Dim oShell As Object
Dim oLink As Object
'you don’t need to import anything in the project reference to create the Shell Object