Klasör yolu düzenleme

[ASLAN7410]

Merhaba hayırlı geceler.

Ekte gönderdiğim excel dosyasındaki makro C sürücüsünün içerisine ÇALIŞMA isimli klasör oluşturuyor.

Benim istediğim bu klasörü masa üzerine oluşturmasını istiyorum, klasör yolunu düzenleyebilir misiniz?

Yardımcı olur musunuz?

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:\ÇALIŞMA\" & Range("A" & i))
    If bak <> True Then
        dosya.CreateFolder "C:\ÇALIŞMA\" & Range("A" & i)
    End If
Next i
 
End Sub

 

[PLİNT]

Merhaba
Şöyle deneyin."A" sütunundaki verileri klasöre ad vererek masaüstüne oluşturur.

  Sub KlasorOlustur()
Dim i As Long
Dim dosya, bak, kayıt
 
Set dosya = CreateObject("Scripting.FileSystemObject")
Set kayıt = CreateObject("wscript.Shell")
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    bak = dosya.FolderExists(kayıt.SpecialFolders.Item("Desktop") & Application.PathSeparator & Range("A" & i))
    If bak <> True Then
        dosya.CreateFolder kayıt.SpecialFolders.Item("Desktop") & Application.PathSeparator & Range("A" & i)
    End If
Next i
 
End Sub

 

[ASLAN7410]

Sayın PLİNT ilginiz için çok teşekkür ediyorum.

Galiba yanlış anlattım, ÇALIŞMA klasörünü masa üzerine oluşturup,
bu klasör içerisine A sütunundaki isimlere göre ÇALIŞMA klasörü içerisine klasör oluşturmasını istemiştim.

 

[PLİNT]

Sayın PLİNT ilginiz için çok teşekkür ediyorum.

Galiba yanlış anlattım, ÇALIŞMA klasörünü masa üzerine oluşturup,
bu klasör içerisine A sütunundaki isimlere göre ÇALIŞMA klasörü içerisine klasör oluşturmasını istemiştim.

Aşağıdaki eklemelerle istediğiniz gibi olacaktır.

[SIZE="2"]Sub KlasorOlustur()
Dim i As Long
Dim dosya, bak, kayıt
 
Set dosya = CreateObject("Scripting.FileSystemObject")
Set kayıt = CreateObject("wscript.Shell")
[COLOR="Blue"]If dosya.FolderExists(kayıt.SpecialFolders.Item("Desktop") & Application.PathSeparator & "\ÇALIŞMA") = False Then _
dosya.CreateFolder kayıt.SpecialFolders.Item("Desktop") & Application.PathSeparator & "\ÇALIŞMA"[/COLOR]
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    bak = dosya.FolderExists(kayıt.SpecialFolders.Item("Desktop") & Application.PathSeparator [COLOR="Blue"]& "\ÇALIŞMA\"[/COLOR] & Range("A" & i))
    If bak <> True Then
        dosya.CreateFolder kayıt.SpecialFolders.Item("Desktop") & Application.PathSeparator [COLOR="Blue"]& "\ÇALIŞMA\"[/COLOR] & Range("A" & i)
    End If
Next i
End Sub [/SIZE]

 

[vardar07]

Kırmızılı yere sizin bilgisayar adını yazarak denermisiniz.

Sub KlasorOlustur()
Dim i As Long
Dim dosya, bak
Set dosya = CreateObject("Scripting.FileSystemObject")
 yol = "C:\Documents and Settings\[COLOR="Red"]xxxxxx[/COLOR]\Desktop\"
 dosya.CreateFolder yol & "ÇALIŞMA"
klasor = yol & "ÇALIŞMA\"
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    bak = dosya.FolderExists(klasor & Range("A" & i))
    If bak <> True Then
        dosya.CreateFolder klasor & Range("A" & i)
    End If
Next i
End Sub

 

[ASLAN7410]

Sayın PLİNT çok teşekkür ederim, ellerinize sağlık tam istediğim gibi oldu.
Hayırlı çalışmalar hayırlı günler dilerim.

Sayın vardar07 sizin kodlarda işe yarıyor ancak kırmızı ile belirtmiş olduğunuz yere bilgisayar adını yazınca oluyor ancak farklı bir bilgisayarda başka arkadaşlar kullandığında çalışmayacak, makrodan anlamayanlar da bu işlemi yapamayacak.

İlgilendiğiniz için size de ayrıca çok teşekkür ederim, hayırlı çalışmalar hayırlı günler dilerim.