Klasör Oluşturmak

[heqle]

Merhaba arkadaşlar bi sorum olacak forumda o kadar arama yaptım ama nafile bulmadım yada yanlış kelimelerle arama yaptım ve sonuç alamadım.

Sorum şu :

excellde A a sutunundaki hücre içinde yazan isimlerin ;
yolu belirtilen dizine klasör oluşturulmasının sağlanması.

örnek :

A
1 PAZARTESİ
2 SALI
3 ÇARŞAMBA
4 PERŞEMBE
5 CUMA
6 CUMARTESİ
7 PAZAR

öyle bi makro olmalı ki a stununda olan değerler adında belirlenen dizinde klasörler oluşssun.makkroyu kullandığımda örneğin C:/Excel_Web_Tr/ dizini içersine PAZARTESİ,SALI,ÇARŞAMBA,PERŞEMBE,CUMA,CUMARTESİ,PAZAR adında klasörler oluştursun.
teşekkür ederim....

 

[Ömer]

Merhaba,

Module kopyalarak çalıştırınız.

Sub KlasorOlustur()
 
Dim i As Long
Dim dosya, bak
 
Set dosya = CreateObject("Scripting.FileSystemObject")
 
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    bak = dosya.FolderExists("C:\Excel_Web_Tr\" & Range("A" & i))
    If bak <> True Then
        dosya.CreateFolder "C:\Excel_Web_Tr\" & Range("A" & i)
    End If
Next i
 
End Sub

.

 

[Korhan Ayhan]

Selamlar,

Ömer bey cevap vermiş. Benim önerimde alternatif olsun. "C" klasörünün altında "C:\Excel_Web_Tr\" dizini yoksa onuda oluşturuyor.

Option Explicit
 
Sub KLASÖR_OLUŞTUR()
    Dim X As Integer, Dosya_Adı As String
    Dim Dosya_Yolu As String, Dosya_Sistemi As Object
 
    Set Dosya_Sistemi = CreateObject("Scripting.FileSystemObject")
 
    Dosya_Yolu = "C:\Excel_Web_Tr\"
 
    If Not Dosya_Sistemi.FolderExists(Dosya_Yolu) Then
        Dosya_Sistemi.CreateFolder (Dosya_Yolu)
    End If
 
    For X = 1 To 7
        Dosya_Adı = Dosya_Yolu & Cells(X, 1)
        If Not Dosya_Sistemi.FolderExists(Dosya_Adı) Then
            Dosya_Sistemi.CreateFolder (Dosya_Adı)
        End If
    Next
 
    Set Dosya_Sistemi = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[heqle]

çok teşekkürler çok sağolun