Klasördeki resmi silme

[oornek1]

Merhaba;

bir excel listem var yaklaşım 7000 kayıt var ve resimleri var resimlerin bulunduğu klasörde fazla resim var benim istediğim excel listesindeki resimler kalacak listede olmayan resimleri klasörden silmek istiyorum bunu yapabilirmiyim

 

[oornek1]

anlaşılan bu şekilde bir işlem yapamıyoruz peki excel listemde yer alan fotoğrafları başka bir klasöre taşıyabilirmiyim,

 

[halit3]

Merhaba;

bir excel listem var yaklaşım 7000 kayıt var ve resimleri var resimlerin bulunduğu klasörde fazla resim var benim istediğim excel listesindeki resimler kalacak listede olmayan resimleri klasörden silmek istiyorum bunu yapabilirmiyim

evet yapabilirsiniz.

 

[oornek1]

evet yapabilirsiniz.

nasıl yapabileceğim konusunda yardımcı olurmusunuz

 

[oornek1]

Excelde b2 hücresinden itibaren elimde resimler klasöründeki resümlerin listesi var bu klasör içerisinde mükerrer resimler mevcut ama excel listemde yazılı olan resimleri kullanmamız gerekiyor excel listede yazılı olan resimleri, Resimler klasöründen keserek Data klasörüne yapıştırmasını konusunda yardım edebilirmisiniz,

Not: yaklaşık 6500 kayıt var ve 7000 e yakın resim var

 

[Haluk]

B sütununda yazan resimlerin adı mı, yoksa dosya yolu mu?

C:\TestFolder\Resimler\Resim2.jpg gibi bir şey mi?

.

 

[oornek1]

B sütununda yazan resimlerin adı mı, yoksa dosya yolu mu?

C:\TestFolder\Resimler\Resim2.jpg gibi bir şey mi?

.

Evet haluk bey resim yolu “Resimler/resim2.jpg” şeklinde

 

[Haluk]

Deneme yapma şansım olmadı, siz klasör yollarını kendinize göre değiştirdikten sonra bir deneme yapın ....

Sub Test()
    Dim FSO As Object
    Dim PictureFolder As String, DataFolder As String
    Dim i As Integer, NoB As Integer
    
    PictureFolder = "C\Resimler"
    DataFolder = "C:\Data"
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    NoB = Range("B" & Rows.Count).End(xlUp).Row
    
    For i = 2 To NoB
        If Dir(Range("B" & i).Text) <> "" Then
            tempFile = FSO.GetBaseName(Range("B" & i).Text)
            FSO.CopyFile Range("B" & i).Text, DataFolder & Application.PathSeparator & tempFile
        End If
    Next
    
    Set FSO = Nothing
End Sub

.

 

[oornek1]

Deneme yapma şansım olmadı, siz klasör yollarını kendinize göre değiştirdikten sonra bir deneme yapın ....

Sub Test()
    Dim FSO As Object
    Dim PictureFolder As String, DataFolder As String
    Dim i As Integer, NoB As Integer
   
    PictureFolder = "C\Resimler"
    DataFolder = "C:\Data"
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
   
    NoB = Range("B" & Rows.Count).End(xlUp).Row
   
    For i = 2 To NoB
        If Dir(Range("B" & i).Text) <> "" Then
            tempFile = FSO.GetBaseName(Range("B" & i).Text)
            FSO.CopyFile Range("B" & i).Text, DataFolder & Application.PathSeparator & tempFile
        End If
    Next
   
    Set FSO = Nothing
End Sub

.

380 tane veri kopyaladıktan sonra bu satıra hata veriyor, birde kopyalama olmasada kes yapsak olmazmı
FSO.CopyFile Range("B" & i).Text, DataFolder & Application.PathSeparator & tempFile

 

[Haluk]

Verdigi hata nedir?

Su anda disaridayim, donunce bakayim.

.

 

[oornek1]

Verdigi hata nedir?

Su anda disaridayim, donunce bakayim.

.

Run-Time error '5'
Invalid procedure call or argument

şeklinde bir uyarı veriyor, sonrasında Debug deyince
FSO.CopyFile Range("B" & i).Text, DataFolder & Application.PathSeparator & tempFile
bu alanda sarı olarak işaretliyor,

not: 380 tane taşıyor ama dosya uzantılarını almıyor klasör içerisinde jpg, png gibi uzantılı resimler mevcut dosyaları kopyalama değilde kes yaparak taşıyabilmemiz mümkünmü

 

[Haluk]

Halen disaridayim ama siz o satirin sonuna

& ".jpg"

Ilave edip de dener misiniz? Eger butun resimler bu uzantidaysa tabii....
.

 

[oornek1]

Halen disaridayim ama siz o satirin sonuna

& ".jpg"

Ilave edip de dener misiniz? Eger butun resimler bu uzantidaysa tabii....
.

bütün resimler .jpg değil içlerinde .png olanlarda var

 

[oornek1]

garip bir durum oldu şimdi hatada vermiyor kopyalamada yapmıyor

 

[Haluk]

Aşağıdaki revize kod, tüm isteklerinizi karşılar sanırım. Bütün uzantılar dikkate alınır, resimler Data dosyasına alındıktan sonra orjinal klasörden silinir.
Data klasörünün içindeki önceden kopyalanan tüm dosyaları silip, klasörü boşalttıktan sonra kodu deneyin.

Sub Test3()
    Dim FSO As Object
    Dim PictureFolder As String, DataFolder As String
    Dim i As Integer, NoB As Integer
    
    PictureFolder = "C\Resimler"
    DataFolder = "C:\Data"
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    NoB = Range("B" & Rows.Count).End(xlUp).Row
    
    For i = 2 To NoB
        If Dir(Range("B" & i).Text) <> "" Then
            tempFile = FSO.GetBaseName(Range("B" & i).Text)
            tempExt = FSO.GetExtensionName(Dir(Range("B" & i).Text))
            FSO.MoveFile Range("B" & i).Text, DataFolder & Application.PathSeparator & tempFile & "." & tempExt
        End If
    Next
    
    Set FSO = Nothing
End Sub

.

 

[oornek1]

yine 380 resim aktardıktan sonra aynı hatayı veriyor

 

[Haluk]

Sizin Excel listenizdeki 381. (veya 382.) satırda bir durum var herhalde....

Orada yazan dosya yolu doğru mu? Mükerrer falan mı acaba?

Bu arada, 15. mesajdaki kodu revize ettim.... onu kullanın. Ama, dediğim gibi ..... Excel listenizi iyi kontrol edin.

.

 

[oornek1]

evet kontrol ettim boş satırlar mevcut, sorun düzeldi hocam son birşey daha istesem yardımcı olurmusunuz resmi taşınan kişinin c 2 hücresinden itibaren kopyalandı yada taşındı yazdırabilirmiyiz,

 

[Haluk]

Yukarıda 15. mesajdaki revize kodda, aşağıdaki kırmızı renkli ilaveyi yaparsanız, "Taşındı" ibaresini görürsünüz...

            FSO.MoveFile Range("B" & i).Text, DataFolder & Application.PathSeparator & tempFile & "." & tempExt
            Range("C" & i) = "Taşındı"

.

 

[oornek1]

Teşekkür ederim elinize sağlık