C de şartlı klasör ve içine altklasor acma

[cems]

Ekte normal olarak çalışan , şu anda üstünde kayıt butonu artı klasör aç butonu olan bir userform var.
Şu andaki işlevi , kayıt esnasında b sütununa bakıp burada en son yazılan tc kimlik no ile ;

daha önceden el ile açılmış olan " anaevrakklasoru " içine son tc no ile bir altklasör açıyor.

Sub Klasor_Olustur()

On Error Resume Next
Dim ds
klasor = [b65536].End(3).Row
altklasor = Range("b" & klasor).Value
Set ds = CreateObject("Scripting.FileSystemObject")
ds.CreateFolder "C:\anaevrakklasoru\" & altklasor

MsgBox "kişinin tc nosu  ile - anaevrakklasoru - altında bir altklasör oluşturuldu"

ThisWorkbook.Save
End Sub

ÇÖZÜLDÜ Soru 1 : bir iletişim kutusu açılarak c altına ilk klasörü ad isteyerek açan ve belki başka anaklasor açması gerekecekse bunu yapacak olan kodlar ;

Private Sub CommandButton3_Click()
MsgBox " Bu tuş ile GRUP DOSYASI açılır. Bireysel, tc kimlik ya da isme göre açmak için diğer tuşu kullan"
Dim bilgi As String
 
bilgi = InputBox("Açılmasını istediğiniz ANA KLASOR adı nedir ? ", "Oluşturma", "ANA KLASOR AÇMA ")
On Error Resume Next
'ad = InputBox("Klasör ismi girin")
MkDir "c:\" & [bilgi]
Call Klasor_Olustur
 
MsgBox "Ana klasor olarak , üst klasör oluşturuldu. Ayrıca son girilen ad soyad ile alt klasör de açıldı." & bilgi
 ThisWorkbook.Save
End Sub

Soru 2 : Şu anki kodlarla bu klasörün içine sayısal olarak tc no ile alt klasör açıyor.Ancak
aynı isimde klasör varsa "hata: file already exist" veriyor ve duruyor . Aynı dosya
adının varlığı durumunda hata yerine msgbox ile seçimli uyarı verdiren ve seçime
göre ilerleyen ya da sonlanan kodlar ;

ÇÖZÜLDÜ Soru 3 : c sütununda numerik olmayan data olarak ad soyadlar var. Tc no ile nümerik
değil ama c sütunundaki alfabetik ad soyad ile altklasör açan kodlar.

Sub Klasor_Olustur()

On Error Resume Next
Dim ds
klasor = [c65536].End(3).Row
altklasor = Range("c" & klasor).Value
Set ds = CreateObject("Scripting.FileSystemObject")
ds.CreateFolder "C:\anaevrakklasoru\" & altklasor

MsgBox "kişinin adı soyadı   ile - anaevrakklasoru - altında bir altklasör oluşturuldu"

ThisWorkbook.Save
End Sub

Yeni Örnek eklenmiştir.

 

[cems]

Soru 2 kaldı , bakalım onu da çözebilir miyim ? Ancak , ana klasör içine alt klasör atmak karışık , belki yardım edilir.

Dosya soru 1 cozumu ile yeniden yuklendi.

 

[muygun]

Merhaba;
Sorunuzu tam anlayamamış olabilirim ama ;
Klasör ve içinde alt klasör oluşturmak istiyorsanız;

Sub klasör_oluştur()
yer = "C:\"
bir = "ana klasör" ' veya bir textbox oluşturarak ordan alabilirsiniz.
iki = TextBox3 'alt klasör1

klasor1 = yer & "\" & bir
klasor2 = yer & "\" & bir & "\" & iki
If CreateObject("Scripting.FileSystemObject").FolderExists(klasor1) = False And klasor1 <> "" Then MkDir klasor1
If CreateObject("Scripting.FileSystemObject").FolderExists(klasor2) = False And klasor2 <> "" Then MkDir klasor2
End Sub

kodlarını kayıt butonu başlangıcında çalıştırın.

İyi çalışmalar.

 

[cems]

Sayın Muygun ;

Ana ve alt klasörü aynı anda ve kayıt esnasında oluşturmak için ;
userforma fazladan iki textbox yerleştirip call prosedürü ile çağrılan modüle verdiğiniz kodları uyguladım. Kodlar sorunsuz çalışarak hem userform kaydı yaptı hem de ana ve içinde alt klasörünü ( ana klasör -> BÜTÜN PERSONEL EVRAKI alt klasör -> Yönetici evrakları) açtı .

Bir değişik deneme olarak ;

textbox1 adını değiştirmeden textbox2 adını değiştirdim ve yeni bir kayıt yaptım.
Ana klasör BÜTÜN PERSONEL EVRAKI içinde
varolan Yönetici evrakları yanına
yeni klasör Formen personel evrakları

..da açtı

Sorular hızır tarzınız ve bilginiz sayenizde tamamlanmış oldu, çok teşekkür ederim