[DOX.1]

السـلام عليكم روحمة الله وبركاته 

عندي أستفسـار عندي برنامج يعمل على جهاز 
محتاج أن البرنامج يبحث عن المجلدات الموجوده في ( Users) وينشأ لكل مجلد أختصار للبرنامج يعني شورت كت في سطح المكتب اللي عنده

ضروري

[عبدالله الدوسري]

وعليكم السلام ورحمة الله وبركاتة 


تحتاج فقط إلى إنشاء إختصار في المجلد Public
C:\Users\Public\Desktop

وسيظهر لجميع المستخدمين

[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

[DOX.1]

كيف اتمكن من عمل جملة For  
لجلب جميع المجلدات داخل Users

[asemshahen5]

تفضل هذا المثال : به ما طلبته يجلب لك أسماء المجلدات الموجودة في مجلد المستخدمين و يعمل لها اختصارا على سطح المكتب .

[DOX.1]

يظهر لي خطأ على المكتبه هاذي كيف أنزلها 
IWshRuntimeLibrary

[DOX.1]

كود :

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

   Try

       oShell = CreateObject("WScript.Shell")
       oLink = oShell.CreateShortcut(ShortCutPath & "\" & ShortCutName & ".lnk")

       oLink.TargetPath = TargetName
       oLink.WindowStyle = 1
       oLink.Save()
   Catch ex As Exception

   End Try

End Function

هل من الممكن أحد يشرح لي عمل هذه الفانكشن 
وكيف أقدر أستغلها في أنشاء الأختصار

[asemshahen5]

(17-09-18, 11:20 AM)DOX.1 كتب : يظهر لي خطأ على المكتبه هاذي كيف أنزلها 
IWshRuntimeLibrary

موجودة بمرفقات المشاركة رقم 3

[DOX.1]

مهي موجوده ثبتها من النت وضبط الوضع 
بس الفانكشن الأخيره ممكن ترتيبها لي بحيث أنها تعمل شورت كت 
المثال اللي أرسلته جميل لكن ما عرفت أتعامل معه

[asemshahen5]

مالذي لم تعرفه في التعامل معه نسيت أن أخبرك تستطيع وضع إختصارات في هذه الأماكن باستدال كلمة Destop بها .

      Desktop
     Favorites
       SendTo
   StartMenu
       Startup
    Programs