Hücre isimlerinden iç içe klasör oluşturma

[cimatron]

merhaba,

ekteki excell dosyasındaki "KLASÖR DİZİNLERİ" sayfasındaki benim seçeceğim bir hedefe "DİZİN-1" ana klasör oluşturacak ardından bu klasörün içine "DİZİN-2" klasörünü oluşturacak ardından bu klasör içine "DİZİN-3_1 , DİZİN-3_2 , DİZİN-3_3 , DİZİN-3_4 , DİZİN-3_5" klasörlerini oluşturmasını istiyorum ve bunu alt alta ne kadar satır varsa bitene kadar tekrarlaması gerekmekte.fakat bunu her alt satırdaki "DİZİN-1" ana klasörünü ilk seçtiğim hedef dizine oluşturması gerekmekte.

 

[halit3]

kod

Sub aktar()
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path 'Klasor.Items.Item.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
On Error Resume Next
If Right(Kaynak, 1) <> "\" Then Kaynak = Kaynak & "\"
For i = 3 To Cells(Rows.Count, "B").End(3).Row
klasor1 = Cells(i, 2).Value
If Dir(Kaynak & klasor1) = "" Then MkDir Kaynak & klasor1
klasor2 = Cells(i, 4).Value
If Dir(Kaynak & klasor1 & "\" & klasor2) = "" Then MkDir Kaynak & klasor1 & "\" & klasor2
klasor3 = Cells(i, 6).Value
If Dir(Kaynak & klasor1 & "\" & klasor2 & "\" & klasor3) = "" Then MkDir Kaynak & klasor1 & "\" & klasor2 & "\" & klasor3
klasor4 = Cells(i, 8).Value
If Dir(Kaynak & klasor1 & "\" & klasor2 & "\" & klasor4) = "" Then MkDir Kaynak & klasor1 & "\" & klasor2 & "\" & klasor4
klasor5 = Cells(i, 10).Value
If Dir(Kaynak & klasor1 & "\" & klasor2 & "\" & klasor5) = "" Then MkDir Kaynak & klasor1 & "\" & klasor2 & "\" & klasor5
klasor6 = Cells(i, 12).Value
If Dir(Kaynak & klasor1 & "\" & klasor2 & "\" & klasor6) = "" Then MkDir Kaynak & klasor1 & "\" & klasor2 & "\" & klasor6
klasor7 = Cells(i, 14).Value
If Dir(Kaynak & klasor1 & "\" & klasor2 & "\" & klasor7) = "" Then MkDir Kaynak & klasor1 & "\" & klasor2 & "\" & klasor7
Next
MsgBox "  Klasörler oluştu !", vbInformation, "DİKKAT"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub

not:kodu KLASÖR DİZİNLERİ sayfasında çalıştırın

 

[cimatron]

merhaba,

Yazmış olduğunuz kod tek seferde tam istediğim gibi çalışmakta çok teşekkür ederim,peki güvenlik açısından aynı klasör isminden olup da üzerine yazmasını (eğer var olan klasörün içerisindeki dosyaları koruyabilmek için) nasıl engelleyebiliriz?
Ayrıca örnek listede 51 satır bulunmakta bu satır sayısı 500 olsa yine bu kod çalışır mı?

Teşekkürler.

 

[chngrcn]

Harika bir çalışma teşekkürler halit hocam.. Eline sağlık..

 

[halit3]

merhaba,

Yazmış olduğunuz kod tek seferde tam istediğim gibi çalışmakta çok teşekkür ederim,peki güvenlik açısından aynı klasör isminden olup da üzerine yazmasını (eğer var olan klasörün içerisindeki dosyaları koruyabilmek için) nasıl engelleyebiliriz?
Ayrıca örnek listede 51 satır bulunmakta bu satır sayısı 500 olsa yine bu kod çalışır mı?

Teşekkürler.

Kod zaten sayfadaki yazılı değerlerden klasörü oluşturuyor eğer daha önce bu değerle klasör oluşmuşsa yeniden klasör oluşturmuyor.

Diğer taraftan sayfanızdaki veriler kadar klasör oluşturacaktır yanı son satır kadar oluşturacaktır.

 

[cimatron]

Emeğiniz için çok teşekkürler benim için çok iyi bir örnek oldu

 

[halit3]

Harika bir çalışma teşekkürler halit hocam.. Eline sağlık..

Teşekkürler iyi çalışmalar