• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Klasör Oluşturma

Katılım
5 Temmuz 2007
Mesajlar
67
Excel Vers. ve Dili
Türkçe
Merhaba Arkadaşlar Sizden Bir Şey Öğrenmek İstiyorum
Mesala Excel Sayfanın A Hücresine 1 Satırına
( Ankara Eğitim ve Araştırma Hastanesi ) Yazdım Diyelim
Makro İle Bu Hücreye Yazılan İsim Adında
D Diskine Bir Klasör Açabilirmi
Yani D Diskine
Ankara Eğitim ve Araştırma Hastanesi adı altında bir tane klasör
Mümkünmü Acaba
 
yanıt

Kod:
Sub Klasör_Oluştur()
Dim ds
DEG = [A1].Value
Set ds = CreateObject("Scripting.FileSystemObject")
ds.CreateFolder "D:\" & DEG
End Sub
 
Mümkün, kodlar şu an yanımda yok ama böyle bir şey mümkün..
 
Aşağıdaki kodları deneyiniz.

Sub KlsOluşma()
Dim kls, yol
Set kls = CreateObject("Scripting.FileSystemObject")
yol = "D:\" & [a1]
kls.CreateFolder yol
Set ds = Nothing
End Sub
 
Yanliz ŞÖyle Bİr Sorun Varrr Onu SÖylemeyİ Unuttuummm
Şİmdİ A HÜcresİnİn 1 Satirina A Fİrmasini Yazdimyaa
BaŞka Bİr GÜn BaŞka Bİr Fİrma Gelİncede 2 Satirina O Fİrmayi Yazacam O Zamanda Ekleyecekmİ Bu BÖyle Alt Alltaa Gİdecek Veya 4 GÜn 6 Tane Bİr Den Hastane Adi Yazacam Baktim İlk BeŞ Satirda Hastane Adi Var 5 Ten Sonrakİ Satirlara 6 Taneyİ Yazinca O En Son YazmiŞ OlduĞum İsİmler Adi Altindami KlasÖr AÇacak Yoksa Benİm İŞİme O Şekİlde Yarar MÜmkÜnmÜ Acaba
 
ArkadŞlar Ordamisiniz

Bİr Yardimci Olursaniz Sevİnİrİm LÜtfennnn.....
 
yanıt

Kod:
Sub Klasor_Olustur()
On Error Resume Next
Dim ds
DEG = [A65536].End(3).Row
DEG2 = Range("A" & DEG).Value
Set ds = CreateObject("Scripting.FileSystemObject")
ds.CreateFolder "D:\" & DEG2
End Sub
 
Aşağıdaki kodları deneyiniz.

Butona her bastığınızda olmayan klasörleri D sürücüsünde yaratır.

Kod:
Sub KlsOluşma()
Dim kls, yol, a
Set kls = CreateObject("Scripting.FileSystemObject")
For i = 2 To [a65536].End(3).Row
yol = "D:\" & Cells(i, "a")
a = kls.FolderExists(yol)
If a = True Then
MsgBox yol & " isminde bir klasör var", 256, "UYARI"
Else
kls.CreateFolder yol
End If
Next i
MsgBox "Bitti"
Set ds = Nothing
End Sub
 
Kod:
Sub Klasor_Olustur()
On Error Resume Next
Dim ds
DEG = [A65536].End(3).Row
DEG2 = Range("A" & DEG).Value
Set ds = CreateObject("Scripting.FileSystemObject")
ds.CreateFolder "D:\" & DEG2
End Sub

hocam galiba bu A sütunundaki son dolu satırın değeri ile klasör oluşturuyor,

peki a sütunundaki 2 ila son dolu satır daki değerler ile klasör oluşturmak istesek for next nasıl olacak?

Yada Dizi Tanımlayıpta yapmak mümkünmü bunu mesala
10luk bir dizi olsun Dizin(10) = Dizi1,dizin2,dizin3, aaa1 vs...

değişkendeki diziler ile klasör açılsın
 
Çok TeŞekkÜr Ederİm

Çok TeŞekkÜr Ederİm ArkadaŞlar
Kodlarin İÇİnde En YarayiŞlisi Sn. Rİpek
VermİŞ OlduĞu Kod Oldu
Tam İstedİĞİm Gİbİ İsİmlerİ Tek Tek Denetlİyor Olmayan Ne Varsa O KlasÖrÜ Eklİyor
Çok TeŞekkÜrler....
 
Selamlar forumda buna benzer bir sürü konu gördüm yalnız şöyle bir şey yapılabilirmi?

A sütununda klasör ismi B sütununda da bunun altına açılacak klasör ismi olsun
A_______B
a
_______a1
_______a2
b
_______b1
_______b2
c
..
..
gibi birşey yapılabilir mi?

Teşekkürler
 
Son düzenleme:
ilginç bir soru:) cevabı bende merak ettim
 
Aşağıdaki kodları kulanabilirsiniz.

Kod:
Sub KlsOlusturma()
Dim fso, kls, altkls, a, b, i
Set fso = CreateObject("Scripting.FileSystemObject")
For i = 2 To [a65536].End(3).Row
    kls = Cells(i, "a")
    a = fso.FolderExists(kls)
        If a = True Then
            altkls = kls & "\" & Cells(i, "b")
            b = fso.FolderExists(altkls)
                If b = False Then
                    fso.CreateFolder altkls
                Else
                MsgBox altkls & " isminde bir klasör var.", 256, "UYARI"
                End If
        Else
            MsgBox kls & " isminde bir klasör yok.", 256, "UYARI"
        End If
Next i
MsgBox "Bitti"
Set fso = Nothing
End Sub
 
Eline sağlık sağlık üstad ama ben a sütununa yazdığımında klasör olmasını istiyordum bu yüzden affınıza sığınırak mavi satırı kırmızı satır gibi değiştirdim.

Sub KlsOluşma()
Dim fso, kls, altkls, a, b, i
Set fso = CreateObject("Scripting.FileSystemObject")
For i = 2 To [a65536].End(3).Row
kls = Cells(i, "a")
a = fso.FolderExists(kls)
If a = True Then
altkls = kls & "\" & Cells(i, "b")
b = fso.FolderExists(altkls)
If b = False Then
fso.CreateFolder altkls
Else
MsgBox altkls & " isminde bir klasör var.", 256, "UYARI"
End If
Else
MsgBox kls & " ismind e bir klasör yok.", 256, "UYARI"
fso.CreateFolder kls
End If
Next i
MsgBox "Bitti"
Set fso = Nothing
End Sub
 
Sayın VBA Aplicaitons ve Sayın Ripek, paylaşım için çok çok teşekkürler. Çok yararlı kodlar olmuşlar. 3 kodund hepsinin ayrı ayrı değeri var, hepsini kendime göre kullanabileceğim yerlerine ayarladım. Çok çok teşekkürler.
 
Konuyu hortattım ama yardımınıza ihtiyacım var. Kodlamadan anlamam ama hazır kodlar üzerinde ufak tefek değişiklik yaparak istediğimi elde etmeye çalışırım.
Recep İpek'e ait aşağıdaki kodlar kullanım olarak iyi ama onlar üzerinde istediğim şeyleri yapabilmek için kodlamayı bilmem gerekiyor.İstediğim şey excel dosyasını hangi klasöre koyduysam o klasörün içinde hücrelerin isimlerinde klasör açmasını istiyorum. Bunu nasıl yapabilirim. Bu şekilde olursa kodları düzeltmeden istediğim bilgisayarda ve istediğim klasörün içinde hücre isimlerinde klasör açmak dosyanın taşınabilirliğini arttıracağından çok daha iyi olur. Bir de uyarı vermeden eğer o klasör varsa oluşturmasın yoksa oluştursun, çünkü hücrelere yeni veri ekleyince tekrar en baştan tek tek bu isimde klasör var diye uyarı veriyor.

Bu söylediklerimin yapılabilirliği nedir? Kolaymıdır yardımlarınızı bekliyorum.

Sub KlsOluşma()
Dim kls, yol, a
Set kls = CreateObject("Scripting.FileSystemObject")
For i = 2 To [a65536].End(3).Row
yol = "D:\" & Cells(i, "a")
a = kls.FolderExists(yol)
If a = True Then
MsgBox yol & " isminde bir klasör var", 256, "UYARI"
Else
kls.CreateFolder yol
End If
Next i
MsgBox "Bitti"
Set ds = Nothing
End Sub
 
Geri
Üst