مشكلة في كود MKdir

[احمد سعيد]

تم تعديل نوفمبر 25, 2015 بواسطه احمد سعيد
مش عارف اكتب بالتوبيك

[ياسر خليل أبو البراء]

أخي الكريم ارفق الملف الذي به الكود ..

[احمد سعيد]

Test.rar

[الـعيدروس]

Sub MakeFolders()
Dim Rng As Range
Dim maxRows, maxCols, r, c As Integer
Dim Pth As String
Set Rng = Selection
maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count
Pth = "C:\Users\abdu\Desktop\" '' تحط مسار حفظ المجلدات هنا
For c = 1 To maxCols
r = 1
On Error Resume Next
Do While r <= maxRows
If Len(Dir(Pth & Rng(r, c), vbDirectory)) = 0 Then
MkDir (Pth & Rng(r, c))
End If
r = r + 1
Loop
Next c
On Error GoTo 0
End Sub

 

هكذا لتحديد مسار

Sub MakeFolders()
Dim Rng As Range
Dim maxRows, maxCols, r, c As Integer
Dim Ali_F As Object
Dim Pth As String
Set Rng = Selection
maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count
Pth = "C:\Users\abdu\Desktop\"  '' تحط مسار حفظ المجلدات هنا
For c = 1 To maxCols
r = 1
On Error Resume Next
Do While r <= maxRows
Set Ali_F = CreateObject("Scripting.FileSystemObject")
  If Not Ali_F.FolderExists(Pth & Rng(r, c)) Then
       Ali_F.CreateFolder (Pth & Rng(r, c))
  End If
r = r + 1
Loop
Next c
On Error GoTo 0
Set Ali_F = Nothing
End Sub

 

    واذا لم تعمل معك اداة MkDir جرب هذا الكود بطريقة اخرى

[احمد سعيد]

Test.rar

[ياسر خليل أبو البراء]

أخي الكريم احمد

ترفق الملف وفقط بدون توضيح للمطلوب ..

الملف الأخير يعمل بشكل عادي ولا مشاكل فيه .... ما هي المشكلة الآن ؟؟ نرجو الإفادة

 

[احمد سعيد]

[ياسر خليل أبو البراء]

جرب متصفح تاني ..ممكن يكون فيه مشكلة بالمتصفح أو بنسخة الويندوز والدليل أننا نقوم بالرد كما ترى بشكل عادي

[احمد سعيد]

اشكرك تم الحل باستخدام الفايرفوكس بدلا من الكروم

وطلبي اني اريد تعديل الكود على اخر ملف مرفق انه يفتح الفولدر بعد عمله تلقائية ولك جزيل الشكر

[ياسر خليل أبو البراء]

جرب الكود التالي عله يفي بالغرض

Sub CreateOpenFolderUsingDialog()
    Dim sPath As String
    sPath = GetFolder
    
    If Len(sPath) <> 0 Then
        sPath = sPath & "\" & Range("A1").Value
        
        If Dir(sPath, vbDirectory) = vbNullString Then
            MkDir sPath
        End If
        
        Shell "Explorer.exe" & " " & Chr(34) & sPath & Chr(34), vbNormalFocus
    End If
End Sub

Function GetFolder() As String
    Dim dlg As FileDialog
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    dlg.InitialFileName = "C:\"
    If dlg.Show = -1 Then
        GetFolder = dlg.SelectedItems(1)
    End If
End Function

 

[احمد سعيد]

جزاك الله كل خير الف الف شكر اخي تمام كده

[ياسر خليل أبو البراء]

الحمد لله أن تم المطلوب على خير

الحمد لله الذي بنعمته تتم الصالحات

تقبل وافر تقديري واحترامي أخي الحبيب أبو نصار

تقبل تحياتي أخي الكريم أحمد سعيد