كود إنشاء مجلد يكون كالتالي :

[KHMB]

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

اللهم اجعلنا جميعاً من المرحومين في اولة والمغفور لنا في وسطة وان يعتقنا من النار.

اخواني نرجوا المحاولة في طلبي هذا

كود إنشاء مجلد يكون كالتالي : C:\Program Files\KHMB1\KHMB2 اي مجلد 2 داخل مجلد1 داخل مجلد البرامج على المحث سي.

وجزاكم الله خيراً

شاكراً لكم حسن تعاملكم وتعاونكم مع الجميع

[عبدالله المجرب]

اخي الفاضل راجع الرابط ادناه قد تجد به ما يفيدك في ما تطلب

أبواحمد

http://www.officena.net/ib/index.php?showtopic=37785

[KHMB]

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

الاخ ابو احمد جزاك الله خير ولكن لم استفد من الرابط

بالنسبة لإنشاء مجلد داخل مجلد البرامج هذا الكود :

Sub MkF()

On Error Resume Next

Dim fs As Object

Dim fa As Object

Dim fs1 As Object

Dim fa1 As Object


Set fs = CreateObject("Scripting.FileSystemObject")

Set fs1 = CreateObject("Scripting.FileSystemObject")

If IsNull(ThisWorkbook.Path) Then Exit Sub

   If fs.FolderExists("C:\Program files\KHMB") = True Then

   MsgBox "File available"

   Else

   Set fa = fs.Createfolder("C:\Program files\KHMB")

   MsgBox "Created the folder"

   End If

End Sub

وهو شغال بإمتياز لكن المشكلة في إنشاء مجلد آخر داخل مجلد KHMB

[ابو ياسر]

السلام عليكم

تفضل تم تعديل الكود ووضع الاحتياطات للمجلد الثاني في حال وجوده

المسار على C:\ عدل حسب رغبتك

On Error Resume Next

Dim fs As Object

Dim fa As Object

Dim fs1 As Object

Dim fa1 As Object


   Set fs = CreateObject("Scripting.FileSystemObject")

   Set fs1 = CreateObject("Scripting.FileSystemObject")

   If IsNull(ThisWorkbook.Path) Then Exit Sub

   If fs1.FolderExists("C:\KHMB\KHMB2") = True Then

   MsgBox "File available"

   ElseIf fs.FolderExists("C:\KHMB") = True And fs1.FolderExists("C:\KHMB\KHMB2") = False Then

   Set fa1 = fs.Createfolder("C:\KHMB\KHMB2")

   MsgBox "Created the folder"

   Else

   Set fa = fs.Createfolder("C:\KHMB")

   Set fa1 = fs.Createfolder("C:\KHMB\KHMB2")

   MsgBox "Created the folder"

   End If

[KHMB]

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

نعم اخي سبهاء جزاك الله خير

تم التعديل حسب الرغبة وعمل الكود بكفاءه

الكود بعد التعديل

On Error Resume Next

Dim fs As Object

Dim fa As Object

Dim fs1 As Object

Dim fa1 As Object


   Set fs = CreateObject("Scripting.FileSystemObject")

   Set fs1 = CreateObject("Scripting.FileSystemObject")


   If fs1.FolderExists("C:\PROGRAM FILES\KHMB\KHMB2") = True Then

   MsgBox "File available"


   ElseIf fs.FolderExists("C:\PROGRAM FILES\KHMB") = True And fs1.FolderExists("C:\PROGRAM FILES\KHMB\KHMB2") = False Then

   Set fa1 = fs.Createfolder("C:\PROGRAM FILES\KHMB\KHMB2")

   MsgBox "Created the folder"


   Else

   Set fa = fs.Createfolder("C:\PROGRAM FILES\KHMB")

   Set fa1 = fs.Createfolder("C:\PROGRAM FILES\KHMB\KHMB2")

   MsgBox "Created the folder"

   End If