klasördeki resim dosyaları gruplama

[modoste]

merhaba sayın hocalarım
daha önce excelde klasörlerdeki dosyaları sıralamak ile ilgili makro uygulaması yapılmıştı ve hala kullanmaktayım, excel sorusu sormayacağım ama yardım gelebilir diye düşündüm

şimdiki sorum bilgisayar sorusu gibi ama aramalarıma rağmen konuyla ilgili bir çözüm alamadım
bilgisayarımda bir klasörde whatsuptan gelen resimler var yada benim çektiğim resimler diyelim
IMG-20230822-WA0003.jpg gibi her resmin adı bu şekilde (22 ağustos 2023 te çekilmiş foto)

bu resimleri günlük aylık gruplara nasıl ayırabilirim,
gün gün ayırsam yetiyo

 

[tugkan]

Merhaba,

Photomove diye bir program var.(Ben kullanmadım) Söylediklerine göre senin istediklerini yapıyor. Aşağıya indirme linkini bırakıyorum. Bir denersiniz


Photomove

 

[muhasebeciyiz]

Bulk Rename Utility - Free File Renaming Software

Bulk Rename Utility: Free File Rename Utility for Windows. Bulk Rename Utility allows you to easily batch rename files and folders based upon many flexible criteria. Free Download.

www.bulkrenameutility.co.uk

Bulk Rename Utility çok güçlü ve ücretsiz bir dosya ismi değiştirme aracıdır. Resim dosyalarınızın adlarında tarih bilgisi varsa, bu aracı kullanarak dosya isimlerini hızlıca düzenleyebilir ve ardından istediğiniz şekilde klasörlere taşıyabilirsiniz. Dosya adı IMG-20230822-WA0003.jpg olan resimleri, 2023/08/22/IMG-20230822-WA0003.jpg şeklinde yeniden adlandırarak ilgili klasörlere taşıyabilirsiniz.

Advanced Renamer - Batch file renaming for Windows and macOS

Batch file renamer for Windows and macOS. Rename music, videos, images, and documents quickly and easily with this powerful, flexible tools.

www.advancedrenamer.com

Eğer hızlı bir şekilde resimlerinizi tarih bazında gruplamak istiyorsanız, PhotoMove fotoğraflar için özel olarak tasarlanmış bir araç olduğu için iyi bir tercih olabilir. Eğer daha genel bir dosya düzenleme aracı arıyorsanız, Bulk Rename Utility veya Advanced Renamer gibi araçlar, dosya adlarını tarih bilgisine göre gruplamanıza ve taşımanıza yardımcı olacaktır.

 

[Biolightant]

Merhaba,
Normal fotoğraf makinaları ile çekilmiş fotolar da EXIF meta bilgilerine göre Tarih bakılıyor
ama sanırım sizin fotolar normal foto değil

Dosya Değiştirilme tarihine göre taşıma sanırım işinize yarayabilir.

Yıl Yıl yapmisim siz Gün Gün ayarlarsiniz...

Sub DosyalariTariheGoreTasima()
    Dim fd As FileDialog
    Dim klasorYolu As String
    Dim dosyaAdi As String
    Dim dosyaYolu As String
    Dim hedefKlasor As String
    Dim dosyaTarihi As String
    Dim dosyaYili As String
    Dim fso As Object
    Dim yeniDosyaAdi As String
    Dim sayac As Integer

    ' FileDialog ile klasör seç
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Title = "Lütfen resim dosyalarının olduğu klasörü seçin"
        If .Show <> -1 Then Exit Sub ' İptal edilirse çıkış yap
        klasorYolu = .SelectedItems(1)
    End With

    ' FileSystemObject nesnesi oluştur
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' Seçilen klasördeki tüm dosyaları kontrol et
    dosyaAdi = Dir(klasorYolu & "\*.*") ' Tüm dosyaları listele
    Do While dosyaAdi <> ""
        dosyaYolu = klasorYolu & "\" & dosyaAdi

        ' Sadece resim dosyalarını işle
        If LCase(fso.GetExtensionName(dosyaYolu)) Like "jpg" Or _
           LCase(fso.GetExtensionName(dosyaYolu)) Like "jpeg" Or _
           LCase(fso.GetExtensionName(dosyaYolu)) Like "png" Or _
           LCase(fso.GetExtensionName(dosyaYolu)) Like "gif" Then

            On Error Resume Next
            ' Dosya tarihini al (Değiştirilme tarihi)
            dosyaTarihi = FileDateTime(dosyaYolu)
            On Error GoTo 0

            ' Tarihten yılı al
            If dosyaTarihi <> "" Then
                dosyaYili = Year(dosyaTarihi)
            Else
                dosyaYili = "TarihBelirsiz"
            End If

            ' Hedef klasörü oluştur
            hedefKlasor = klasorYolu & "\" & dosyaYili
            If Not fso.FolderExists(hedefKlasor) Then
                fso.CreateFolder hedefKlasor
            End If

            ' Çakışmaları önlemek için dosya adını kontrol et
            yeniDosyaAdi = dosyaAdi
            sayac = 1
            Do While fso.FileExists(hedefKlasor & "\" & yeniDosyaAdi)
                yeniDosyaAdi = fso.GetBaseName(dosyaAdi) & "_" & sayac & "." & fso.GetExtensionName(dosyaAdi)
                sayac = sayac + 1
            Loop

            ' Dosyayı hedef klasöre taşı
            fso.MoveFile dosyaYolu, hedefKlasor & "\" & yeniDosyaAdi
        End If

        ' Sonraki dosyaya geç
        dosyaAdi = Dir
    Loop

    MsgBox "Tüm resimler ilgili klasörlere taşındı.", vbInformation, "Tamamlandı"

    ' Temizlik
    Set fso = Nothing
End Sub

 

[modoste]

kodlar konusunda bilgim yok
yıl/Ay/Gün olarak makroyu revize edebilirmiyiz.

Ayrıca Photomove kullanmaya başladım ama exceldeki çözümüde bilmek isterim

 

[tugkan]

Ayrıca Photomove kullanmaya başladım

Nasıl? tavsiye eder misin?

 

[modoste]

şu an tam çözemedim sorunumu ama
benim resim dosyalarım .jpg ama programın çevirdiği format .jpeg
20283 adet resmi çevirmesini istedim içinde 1 adet .jpeg buldu (gerçektende içinde 2023 kasım dan 1 adet vardı) hemen yıl ay gün klasörüne ayırdı (güzel program kullanılabilir)

 

[Biolightant]

yıl/Ay/Gün olarak makroyu revize edebilirmiyiz.

Revize kodlar.

Sub DosyalariTariheGoreTasima()
    Dim fd As FileDialog
    Dim klasorYolu As String
    Dim dosyaAdi As String
    Dim dosyaYolu As String
    Dim hedefKlasor As String
    Dim dosyaTarihi As String
    Dim dosyaGunGun As String
    Dim fso As Object
    Dim yeniDosyaAdi As String
    Dim sayac As Integer

    ' FileDialog ile klasör seç
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Title = "Lütfen resim dosyalarının olduğu klasörü seçin"
        If .Show <> -1 Then Exit Sub ' İptal edilirse çıkış yap
        klasorYolu = .SelectedItems(1)
    End With

    ' FileSystemObject nesnesi oluştur
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' Seçilen klasördeki tüm dosyaları kontrol et
    dosyaAdi = Dir(klasorYolu & "\*.*") ' Tüm dosyaları listele
    Do While dosyaAdi <> ""
        dosyaYolu = klasorYolu & "\" & dosyaAdi

        ' Sadece resim dosyalarını işle
        If LCase(fso.GetExtensionName(dosyaYolu)) Like "jpg" Or _
           LCase(fso.GetExtensionName(dosyaYolu)) Like "jpeg" Or _
           LCase(fso.GetExtensionName(dosyaYolu)) Like "png" Or _
           LCase(fso.GetExtensionName(dosyaYolu)) Like "gif" Then

            On Error Resume Next
            ' Dosya tarihini al (Değiştirilme tarihi)
            dosyaTarihi = FileDateTime(dosyaYolu)
            On Error GoTo 0

            ' Tarihten Yıl_Ay_Gün ayarla
            If dosyaTarihi <> "" Then
                dosyaGunGun = Format(dosyaTarihi, "yyyy_mm_dd")
            Else
                dosyaGunGun = "TarihBelirsiz"
            End If

            ' Hedef klasörü oluştur
            hedefKlasor = klasorYolu & "\" & dosyaGunGun
            If Not fso.FolderExists(hedefKlasor) Then
                fso.CreateFolder hedefKlasor
            End If

            ' Çakışmaları önlemek için dosya adını kontrol et
            yeniDosyaAdi = dosyaAdi
            sayac = 1
            Do While fso.FileExists(hedefKlasor & "\" & yeniDosyaAdi)
                yeniDosyaAdi = fso.GetBaseName(dosyaAdi) & "_" & sayac & "." & fso.GetExtensionName(dosyaAdi)
                sayac = sayac + 1
            Loop

            ' Dosyayı hedef klasöre taşı
            fso.MoveFile dosyaYolu, hedefKlasor & "\" & yeniDosyaAdi
        End If

        ' Sonraki dosyaya geç
        dosyaAdi = Dir
    Loop

    MsgBox "Tüm resimler ilgili klasörlere taşındı.", vbInformation, "Tamamlandı"

    ' Temizlik
    Set fso = Nothing
End Sub

 

[modoste]

çözüm mükemmel

çok teşekkür ederim

 

[modoste]

klasörleri yıl gün ay programlara baksamda sonuç alamadım ama excelin ayrıca bu tip işlerde yapması çok çok iyi
exceli sevmenin bir gerekçesi daha

 

[Korhan Ayhan]

İşin özünde klasör oluşturma ve dosya taşıma gibi işlemler olunca VBA kodlarıyla yapamayacağınız işlem yok gibi...

 

[Biolightant]

çözüm mükemmel

işe yaramasına sevindim kolay gelsin.

VBA kodlarıyla yapamayacağınız işlem yok gibi...

Evet esas başrol oyuncusu VB (Visual Basic) in
VBA (Visual Basic for Applications) : Microsoft Office uygulamaları (Excel, Word vb.) için özelleştirilmiş bir sürümü.