Klasördeki resmi silme

Katılım
31 Mart 2008
Mesajlar
162
Excel Vers. ve Dili
2003 türkçe
Altın Üyelik Bitiş Tarihi
26-11-2022
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
 
Katılım
31 Mart 2008
Mesajlar
162
Excel Vers. ve Dili
2003 türkçe
Altın Üyelik Bitiş Tarihi
26-11-2022
anlaşılan bu şekilde bir işlem yapamıyoruz peki excel listemde yer alan fotoğrafları başka bir klasöre taşıyabilirmiyim,
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,798
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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.
 
Katılım
31 Mart 2008
Mesajlar
162
Excel Vers. ve Dili
2003 türkçe
Altın Üyelik Bitiş Tarihi
26-11-2022
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

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
B sütununda yazan resimlerin adı mı, yoksa dosya yolu mu?

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

.
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Deneme yapma şansım olmadı, siz klasör yollarını kendinize göre değiştirdikten sonra bir deneme yapın ....

Kod:
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
.
 
Katılım
31 Mart 2008
Mesajlar
162
Excel Vers. ve Dili
2003 türkçe
Altın Üyelik Bitiş Tarihi
26-11-2022
Deneme yapma şansım olmadı, siz klasör yollarını kendinize göre değiştirdikten sonra bir deneme yapın ....

Kod:
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

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Verdigi hata nedir?

Su anda disaridayim, donunce bakayim.

.
 
Katılım
31 Mart 2008
Mesajlar
162
Excel Vers. ve Dili
2003 türkçe
Altın Üyelik Bitiş Tarihi
26-11-2022
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

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Halen disaridayim ama siz o satirin sonuna

& ".jpg"

Ilave edip de dener misiniz? Eger butun resimler bu uzantidaysa tabii....
.
 
Katılım
31 Mart 2008
Mesajlar
162
Excel Vers. ve Dili
2003 türkçe
Altın Üyelik Bitiş Tarihi
26-11-2022
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
 
Katılım
31 Mart 2008
Mesajlar
162
Excel Vers. ve Dili
2003 türkçe
Altın Üyelik Bitiş Tarihi
26-11-2022
garip bir durum oldu şimdi hatada vermiyor kopyalamada yapmıyor
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
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.

Kod:
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
.
 
Son düzenleme:
Katılım
31 Mart 2008
Mesajlar
162
Excel Vers. ve Dili
2003 türkçe
Altın Üyelik Bitiş Tarihi
26-11-2022
yine 380 resim aktardıktan sonra aynı hatayı veriyor
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
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.

.
 
Son düzenleme:
Katılım
31 Mart 2008
Mesajlar
162
Excel Vers. ve Dili
2003 türkçe
Altın Üyelik Bitiş Tarihi
26-11-2022
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

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Yukarıda 15. mesajdaki revize kodda, aşağıdaki kırmızı renkli ilaveyi yaparsanız, "Taşındı" ibaresini görürsünüz...

Rich (BB code):
            FSO.MoveFile Range("B" & i).Text, DataFolder & Application.PathSeparator & tempFile & "." & tempExt
            Range("C" & i) = "Taşındı"
.
 
Katılım
31 Mart 2008
Mesajlar
162
Excel Vers. ve Dili
2003 türkçe
Altın Üyelik Bitiş Tarihi
26-11-2022
Teşekkür ederim elinize sağlık
 
Üst