Klasördeki dosyaları ayır

[işsiz123]

Merhabalar
A:A dosya id si
B:B Yaş
C:C cinsiyet

/genel klasöründeki karışık dosyaları cinsiyete göre be yaş’a göre klasörlere ayıracak
Örnek
A1=1212
B1= 36
C1= Kadın

Kadın klasörü yoksa klasörü açıp içine 36 adında klasör yoksa 36 adında klasör açıp 1212 dosyasını oraya kaydedecek

Diğerlerinde aynı şekilde döngü olacak Saygılar

 

[ÖmerBey]

Merhaba,
Dosya id si dediğiniz dosya adı mı? Bu adda dosya uzantısı da var mı?
C sütununda sadece Kadın ve Erkek mi yazıyor?

 

[işsiz123]

Merhaba,
Dosya id si dediğiniz dosya adı mı? Bu adda dosya uzantısı da var mı?
C sütununda sadece Kadın ve Erkek mi yazıyor?

Evet id uzantısı jpg C sütun kadın ve erkek

 

[ÖmerBey]

Buyurunuz...
Klasör yolunu (4. satırdaki "yol" değişkeni) kendinize göre düzenlemeyi unutmayınız.

Sub Kayit()
Dim yol As String, yyol As String
Dim a As Long
yol = "C:\genel"
KlasorOlustur yol & "\Kadın"
KlasorOlustur yol & "\Erkek"
For a = 1 To Cells(Rows.Count, "A").End(3).Row
    If Dir(yol & "\" & Cells(a, "A").Text) <> "" Then
        If Cells(a, "B") <> "" Then
            yyol = yol & "\" & Cells(a, "C").Text & "\" & Cells(a, "B").Text
            KlasorOlustur yyol
            Name yol & "\" & Cells(a, "A").Text As yyol & "\" & Cells(a, "A").Text
        End If
    Else
        MsgBox yol & "\" & Cells(a, "A").Text & " dosyası yok."
    End If
Next
End Sub

Private Sub KlasorOlustur(dizin As String)
Set kls = CreateObject("Scripting.FileSystemObject")
If kls.FolderExists(dizin) = False Then MkDir (dizin)
End Sub

 

[işsiz123]

Buyurunuz...
Klasör yolunu (4. satırdaki "yol" değişkeni) kendinize göre düzenlemeyi unutmayınız.

Sub Kayit()
Dim yol As String, yyol As String
Dim a As Long
yol = "C:\genel"
KlasorOlustur yol & "\Kadın"
KlasorOlustur yol & "\Erkek"
For a = 1 To Cells(Rows.Count, "A").End(3).Row
    If Dir(yol & "\" & Cells(a, "A").Text) <> "" Then
        If Cells(a, "B") <> "" Then
            yyol = yol & "\" & Cells(a, "C").Text & "\" & Cells(a, "B").Text
            KlasorOlustur yyol
            Name yol & "\" & Cells(a, "A").Text As yyol & "\" & Cells(a, "A").Text
        End If
    Else
        MsgBox yol & "\" & Cells(a, "A").Text & " dosyası yok."
    End If
Next
End Sub

Private Sub KlasorOlustur(dizin As String)
Set kls = CreateObject("Scripting.FileSystemObject")
If kls.FolderExists(dizin) = False Then MkDir (dizin)
End Sub

Teşekkürler

 

[ÖmerBey]

Rica ederim, iyi çalışmalar...

 

[işsiz123]

Rica ederim, iyi çalışmalar...

Her zaman dosyası yok diyor. Bunlar kadın erkek ve yaş’a göre ayrılacak

 

[işsiz123]

Konu güncel

 

[ÖmerBey]

İlgili kod dosyanızın A sütunundaki veriye göre çalışıyor. Belirttiğiniz yolda ilgili dosya yoksa veya uzantısı uymuyorsa bu uyarıyı verir.
Dosya olmazsa da uyarı görmeyeyim diyorsanız msgbox ile başlayan satırı siliniz.

 

[işsiz123]

İlgili kod dosyanızın A sütunundaki veriye göre çalışıyor. Belirttiğiniz yolda ilgili dosya yoksa veya uzantısı uymuyorsa bu uyarıyı verir.
Dosya olmazsa da uyarı görmeyeyim diyorsanız msgbox ile başlayan satırı siliniz.

Tamam ÖmerBey Teşekkürler tekrardan oldu