Macro ile klasör oluşturmak istiyorum

[s.savas]

Merhaba arkadaşlar.
Macro ile klasör oluşturmak için yardımlarınıza ihtiyacım var.
Detaylı açıklama ekte sunulmuştur.

 

[turist]

Ekli dosyadaki buton ile Kullanıcının masaüstüne klasörler oluşturur. Deneyiniz.

 

[Necdet]

Merhaba,

Alternatif olsun.

Public BsKlasor As String

Sub KlasorOlustur()

    Dim Klasor1     As String, _
        klasor2     As String, _
        i           As Long
        
    KlasorSec "Necdet"
    BsKlasor = BsKlasor & Application.PathSeparator
    
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        If Not Klasor1 = Cells(i, "B") Then
            Klasor1 = Cells(i, "B")
            MkDir BsKlasor & Klasor1
            klasor2 = ""
        Else
            If Not klasor2 = Cells(i, "C") Then
                klasor2 = Cells(i, "C")
                MkDir BsKlasor & Klasor1 & Application.PathSeparator & klasor2
            End If
        End If
    Next i
    
    MsgBox "İşlem Tamamlanmıştır...."
    
End Sub

Sub KlasorSec(Necdet As String)

    Dim fdBrowser As FileDialog

    Set fdBrowser = Application.FileDialog(msoFileDialogFolderPicker)
    
    With fdBrowser
    
        'İlk kullanıma aç
        .Title = "Klasör Seçiniz"
        .InitialFileName = "C:\"
        
        'İletişim Kutusunu Göster
        If .Show Then
            BsKlasor = .SelectedItems(1)
        End If
        
    End With

End Sub

 

[s.savas]

Ekli dosyadaki buton ile Kullanıcının masaüstüne klasörler oluşturur. Deneyiniz.

Teşekkür ederim. Kod çalışıyor.
Klasörlerin nerede yaratılması gerektiğini sorup, kullanıcının göstereceği yerde (masa üstü, flash bellek, usb vb) yaratılması şeklinde düzeltme yapılabilirmi?

 

[s.savas]

Merhaba,

Alternatif olsun.

Public BsKlasor As String

Sub KlasorOlustur()

    Dim Klasor1     As String, _
        klasor2     As String, _
        i           As Long
       
    KlasorSec "Necdet"
    BsKlasor = BsKlasor & Application.PathSeparator
   
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        If Not Klasor1 = Cells(i, "B") Then
            Klasor1 = Cells(i, "B")
            MkDir BsKlasor & Klasor1
            klasor2 = ""
        Else
            If Not klasor2 = Cells(i, "C") Then
                klasor2 = Cells(i, "C")
                MkDir BsKlasor & Klasor1 & Application.PathSeparator & klasor2
            End If
        End If
    Next i
   
    MsgBox "İşlem Tamamlanmıştır...."
   
End Sub

Sub KlasorSec(Necdet As String)

    Dim fdBrowser As FileDialog

    Set fdBrowser = Application.FileDialog(msoFileDialogFolderPicker)
   
    With fdBrowser
   
        'İlk kullanıma aç
        .Title = "Klasör Seçiniz"
        .InitialFileName = "C:\"
       
        'İletişim Kutusunu Göster
        If .Show Then
            BsKlasor = .SelectedItems(1)
        End If
       
    End With

End Sub

Necdet hocam teşekkür ederim. Sizin kod da çalışıyor. turist arkadaşın mesajına yazdığım gibi sizin kod da yol gösterilmesine rağmen sürekli C sürücüsünde klasörleri yaratıyor.
Sizin kodu da, kullanıcının göstereceği yerde (masa üstü, flash bellek, usb vb) yaratılması şeklinde düzeltme yapılabilirmi?

 

[Necdet]

Necdet hocam teşekkür ederim. Sizin kod da çalışıyor. turist arkadaşın mesajına yazdığım gibi sizin kod da yol gösterilmesine rağmen sürekli C sürücüsünde klasörleri yaratıyor.
Sizin kodu da, kullanıcının göstereceği yerde (masa üstü, flash bellek, usb vb) yaratılması şeklinde düzeltme yapılabilirmi?

Ben de sizin dediğiniz gibi yaptım zaten. Siz belirliyorsunuz.

 

[s.savas]

Ben de sizin dediğiniz gibi yaptım zaten. Siz belirliyorsunuz.

Evet hocam klasörü nerede oluşturulacağını soruyor ancak gösterilen yerde kayıt oluşmuyor. Sürekli olarak C sürücüsünde oluşuyor klasörler.
Aşağıdaki kodu sanırım yanlış yere yazmış olabilirim.
Bu çalışma kitabı denen yere yazdım.
Diğer kodlarda bir modülün içine koyup butona atadım.

Public BsKlasor As String

 

[s.savas]

Ben de sizin dediğiniz gibi yaptım zaten. Siz belirliyorsunuz.

Hocam özür, kod dediğiniz gibi sorunsuz çalışıyor. Kodu modüle hatalı olarak almışım. Tüm kod bloğunu tek bir modüle koyup bir butona atayınca sorunsuz çalıştı.

 

[s.savas]

Küçük bir düzenleme mümkün olurmu?
İlk satırda S.NO, İLÇESİ, BİRİMİ gibi başlıkların olduğunu düşünürsek klasör oluştururken 2.satırdan itibaren işlem yapsın.

 

[Necdet]

Verdiğim kodlarda for döngüsünü 1 den değil 2 den başlatın olsun bitsin.

 

[s.savas]

Verdiğim kodlarda for döngüsünü 1 den değil 2 den başlatın olsun bitsin.

Eyvallah hocam.

 

[s.savas]

Necdet hocam mazur görürseniz yazdığınız kodla ilgili bir düzeltme, birde ilave talebim olacak.
Birincisi: Macroyu çalıştırınca klasörlerin oluşturulması istenen yeri soran diyalog penceresi geliyor. Bu sırada işlemden vaz geçme anlamında iptal edersek işlem sonlanmadan C dizininde klasörler açılmış oluyor. Bu esnada klasörler açılmadan işlem sonlanmalı.
İkincisi: Mevcut macrodan bağımsız olarak, klasör oluşturma işlemini grup bazında olacak şekilde revize edebilirmiyiz?
Yani klasörler Grup>İlçe>Birim şeklinde oluşturulmalı.

 

[tugkan]

Merhaba,
Ekteki dosyayı inceler misiniz? Sanırım işinizi çözecektir.
A-ÜLKE

B-ŞEHİR​

C-GRUP​

D-İLÇE​

E-BİRİM​

Şeklinde alt klasörleri oluşturabiliyorsunuz. Bi kaç denemeden sonra mantığını daha iyi anlarsınız.
Kolay gelsin...

 

[s.savas]

Merhaba,
Ekteki dosyayı inceler misiniz? Sanırım işinizi çözecektir.
A-ÜLKE

B-ŞEHİR​

C-GRUP​

D-İLÇE​

E-BİRİM​

Şeklinde alt klasörleri oluşturabiliyorsunuz. Bi kaç denemeden sonra mantığını daha iyi anlarsınız.
Kolay gelsin...

Teşekkür ederim arkadaşım.