محمد ايمن قام بنشر مارس 30, 2012 مشاركة قام بنشر مارس 30, 2012 اصدقائي الاعزاء هل يمكن تحويل كود من لغة vb.net الى vba vb.net.txt رابط هذا التعليق شارك More sharing options...
أبو آدم قام بنشر مارس 30, 2012 مشاركة قام بنشر مارس 30, 2012 ممكن توضيح الغاية من الكود الذي تبحث عنه !!! ... لإصدقائك ولن يبخلوا عليك بما لديهم ... ............ رابط هذا التعليق شارك More sharing options...
محمد ايمن قام بنشر مارس 30, 2012 الكاتب مشاركة قام بنشر مارس 30, 2012 (معدل) مشكور اخي الكريم اخي نارت الكود يقوم باستخراج الرقم التسلسلي الاصلي للفلاش ميموري وهو مشابة لهذا الكود On Error GoTo ssx Dim fso As Object Dim dc As Object Dim d As Object Dim xx, xxx As String Set fso = CreateObject("Scripting.FileSystemObject") Set dc = fso.Drives For Each d In dc xx = d.DriveLetter Next xxx = fso.GetDrive(xx).serialnumber MsgBox (xxx), vbInformation, "استخراج رقم الفلاش ميموري" ssx: If Err.Number = 71 Then MsgBox "يرجى ادخال الفلاش ميموري", vbCritical + vbOKOnly, "استخراج رقم الفلاش ميموري" End If ولكن الفرق بي الكودين هو ان الكود الاول يعطيك رقم لا يتغير عند اجراء فورمات للفلاش ميموري اما الكود الثاني الثاني فيعطيك رقم يتغير عند كل عملية فورمات وجزيل الشكر سلفا لكل اخوتي تم تعديل مارس 30, 2012 بواسطه nart lebzo : لإحتواء الكود ضمن المعالج رابط هذا التعليق شارك More sharing options...
محمد ايمن قام بنشر أبريل 2, 2012 الكاتب مشاركة قام بنشر أبريل 2, 2012 (معدل) هل من جديد ؟؟؟ تم تعديل أبريل 2, 2012 بواسطه aimanano رابط هذا التعليق شارك More sharing options...
محمد ايمن قام بنشر أبريل 11, 2012 الكاتب مشاركة قام بنشر أبريل 11, 2012 هل يستطيع الاكسسز عمل مثل هذا ام لا ؟ رابط هذا التعليق شارك More sharing options...
أبو آدم قام بنشر أبريل 12, 2012 مشاركة قام بنشر أبريل 12, 2012 قيد النظر ...... .................. رابط هذا التعليق شارك More sharing options...
محمد ايمن قام بنشر أبريل 18, 2012 الكاتب مشاركة قام بنشر أبريل 18, 2012 هل من جديد رابط هذا التعليق شارك More sharing options...
أبو آدم قام بنشر أبريل 19, 2012 مشاركة قام بنشر أبريل 19, 2012 إخوتي الفضلاء أخي محمد أيمن أرفق لك كود VBA يحقق ما تريد -على ما أظن- عموماً ، وفيما أعرف ، هذا أقصى ما يمكن إستخراجه من Win32_DiskDrive ، كانت رحلة طويلة ومتعبة ولكن أتمنى أن تكون مجدية لك ، فقد كانت غنية ومفيدة وممتعة بالنسبة لي ...... تفضل ... ووافني بالنتيجة ..... Dim objWMIService, objItem, colItems, strComputer On Error Resume Next strComputer = "." Set objWMIService = GetObject("winmgmts:\\" _ & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive") For Each objItem In colItems MsgBox "Computer: " & objItem.SystemName & vbCr & _ "Status: " & objItem.Status & vbCr & _ " ==================================" & vbCr & _ "Name: " & objItem.Name & vbCr & _ "Description: " & objItem.Description & vbCr & _ "Signature: " & objItem.Signature & vbCr & _ "Manufacturer: " & objItem.Manufacturer & vbCr & _ "Model: " & objItem.Model & vbCr & _ "Size: " & Int(objItem.Size / (1073741824)) & " GB" & vbCr & _ "Number of Partitions: " & objItem.Partitions & vbCr & _ "Total Cylinders: " & objItem.TotalCylinders & vbCr & _ "Tracks PerCylinder: " & objItem.TracksPerCylinder & vbCr & _ "Total Heads: " & objItem.TotalHeads & vbCr & _ "Total Sectors: " & objItem.TotalSectors & vbCr & _ "Bytes PerSector: " & objItem.BytesPerSector & vbCr & _ "Sectors PerTrack: " & objItem.SectorsPerTrack & vbCr & _ "Total Tracks: " & objItem.TotalTracks & vbCr & _ "Total SerialNumber: " & objItem.SerialNumber & vbCr & _ " -------- DeviceID Info ---------- " & vbCr & _ "PNPDeviceID: " & objItem.PNPDeviceID Next والله من وراء القصد ... وهو حسبي رابط هذا التعليق شارك More sharing options...
محمد ايمن قام بنشر أبريل 19, 2012 الكاتب مشاركة قام بنشر أبريل 19, 2012 (معدل) السلام عليكم ورحمة الله و بركاته اخي نارت في البداية اسال الله عز وجل ان يجزيك الجنة وكل خير اخي نارت اغبطك على خبرتك واتمنى ان يكون لدي 1 من 100000 من خبرتك الكود يعمل بشكل صحيح ولكن هناك بعض التعديلات التي اريدها اولا الكود يعطي رسالة لكافة الاقراص وهو يجب ان يعطي رسالة للقرص القابل للازالة فقط ( الفلاش ميموري ) ثانيا الكود يعطي رقم الفلاش كمايلي : USBSTOR\DISK&VEN_GENERIC&PROD_USB_FLASH_DISK&REV_0.00\01AF0000000003EA&0 بينما يجب ان يعطي 01AF0000000003EA فقط استخراج رقم الفلاش ميموري 2.rar تم تعديل أبريل 19, 2012 بواسطه محمد ايمن رابط هذا التعليق شارك More sharing options...
محمد ايمن قام بنشر أبريل 20, 2012 الكاتب مشاركة قام بنشر أبريل 20, 2012 (معدل) اخي نارت تحية طيبة و بعد جربت البرنامج اكثر من مرة و تبن لي انه لامشكلة من ظهور الرقم كاملا ( اقصد يمكن الاستغناء عن الطلب الثاني في المشاركة السابقة ) اما التعديل الاول ( امكانية البحث عن الاقراص القلابلة للازالة ) اذا كان ممكنا فيا حبذا واذا لم يكن ممكنا فلا مشكلة واسال الله العلي العظيم ان يجزيك الجنة و كل خير تم تعديل أبريل 20, 2012 بواسطه محمد ايمن رابط هذا التعليق شارك More sharing options...
أبو آدم قام بنشر أبريل 20, 2012 مشاركة قام بنشر أبريل 20, 2012 أخي محمد أيمن تفضل ...... Dim objWMIService, objItem, colItems, strComputer, IDD On Error Resume Next strComputer = "." Set objWMIService = GetObject("winmgmts:\\" _ & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive") For Each objItem In colItems If objItem.InterfaceType = "USB" Then MsgBox "Computer: " & objItem.SystemName & vbCr & _ "Status: " & objItem.Status & vbCr & _ " ==================================" & vbCr & _ "Name: " & objItem.Name & vbCr & _ "Description: " & objItem.Description & vbCr & _ "Signature: " & objItem.Signature & vbCr & _ "Manufacturer: " & objItem.Manufacturer & vbCr & _ "Model: " & objItem.Model & vbCr & _ "Size: " & Int(objItem.Size / (1073741824)) & " GB" & vbCr & _ "Number of Partitions: " & objItem.Partitions & vbCr & _ "Total Cylinders: " & objItem.TotalCylinders & vbCr & _ "Tracks PerCylinder: " & objItem.TracksPerCylinder & vbCr & _ "Total Heads: " & objItem.TotalHeads & vbCr & _ "Total Sectors: " & objItem.TotalSectors & vbCr & _ "Bytes PerSector: " & objItem.BytesPerSector & vbCr & _ "Sectors PerTrack: " & objItem.SectorsPerTrack & vbCr & _ "Total Tracks: " & objItem.TotalTracks & vbCr & _ "Total SerialNumber: " & objItem.SerialNumber & vbCr & _ " -------- DeviceID Info ---------- " & vbCr & _ "PNPDeviceID: " & objItem.PNPDeviceID & vbCr & _ "InterfaceType: " & objItem.InterfaceType End If Next والله من وراء القصد ... وهو حسبي ........... رابط هذا التعليق شارك More sharing options...
محمد ايمن قام بنشر أبريل 20, 2012 الكاتب مشاركة قام بنشر أبريل 20, 2012 والله يا استاذي يعجز لساني عن شكرك ولم اعد اجد كلمات لمدحك بها اسال الله العلي العظيم ان يجزيك الجنة رابط هذا التعليق شارك More sharing options...
أبو آدم قام بنشر أبريل 20, 2012 مشاركة قام بنشر أبريل 20, 2012 الحمدلله الذي بفضله تقضى الحاجات (تمت الاجابة) رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.