resim dosyalarının başındaki iki haneyi toplu silme

[nes432]

resim klasörüm var 19,000 resim var. excelde resim dosyalarının 180 adedinin isimleri yer alıyor sıra ile a sütununda. bu a sutunundaki isimlere karşılık gelen dosyaları bu resim klasöründen seçme sansımız var mı

 

[Necdet]

Yapılır,

da

dosya adlarının bir özelliği var mı, standart mı vs vs vs biraz daha açıklayıcı bilgi verin yardımcı olacak bir arkadaş çıkacaktır.

 

[nes432]

excelde a sutununda bulunan isme göre resim klasöründe bulunan resimleri seçecek. excelde 180 veri var resim klasöründe 19,000 o 180 i 19,000 içinde seçip farklı klasöre alacak. isimler aynı birebir

 

[Necdet]

Merhaba,

Açıklama da pek açıklama olmamış üstelik konu başlığı ile ilgisi yok ama ekteki kodları inceleyiniz.

Exceldeki verilerde dosya uzantılarının olduğu varsayılmıştır. Yoksa kodlara bu uzantıyı da belirtmek gerekir.

Bir Bakılan dizinden Aktarılacak dizine kes ve yapıştırma mı yapacak, yoksa bir kopyasını mı oluşturacak belli olmadığı için kodların içine her iki olasılığı koydum. Kodda kopyalama yapıyor, diğeri işlevsiz. Siz kullanmayacağınız bölümü açıklama hale getirip diğereni kullanabilirsiniz.

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.

Sub DosyaKopyala()

    Dim BakilacakDizin      As String, _
        AktarilacakDizin    As String, _
        i                   As Long, _
        fd                  As FileDialog, _
        vrtSelectedItem     As Variant, _
        VazGectim           As Boolean
    
    For i = 1 To 2
        VazGectim = False
        Set fd = Application.FileDialog(msoFileDialogFolderPicker)
        With fd
            If .Show = -1 Then
                For Each vrtSelectedItem In .SelectedItems
                    If i = 1 Then
                        BakilacakDizin = vrtSelectedItem & Application.PathSeparator
                    Else
                        AktarilacakDizin = vrtSelectedItem & Application.PathSeparator
                    End If
                Next vrtSelectedItem
            Else
                VazGectim = True
            End If
        End With
        Set fd = Nothing
        If VazGectim = True Then Exit For
    Next i
    
    If VazGectim = True Then Exit Sub
    MsgBox "Bakılacak  Dizin : " & BakilacakDizin & " Aktarılacak Dizin : " & AktarilacakDizin
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        'Bakılacak Dizindeki Dosyayı Aktarılacak Dizine Kopyalar
        FileCopy BakilacakDizin & Cells(i, "A"), AktarilacakDizin & Cells(i, "A")
        'Bakılacak D izindeki Dosyayı Aktarılacak Dizine Silip Aktarır
'        Name BakilacakDizin & Cells(i, "A") As AktarilacakDizin & Cells(i, "A")
    Next i
    
End Sub