Makroda Hata raporu alınması

HALILİBRAHIM

Altın Üye
Katılım
1 Eylül 2008
Mesajlar
90
Excel Vers. ve Dili
2007
tr.
Altın Üyelik Bitiş Tarihi
21-05-2027
Merhaba,

Ben bir makro yardımı ile resim dosyalarımı başka bir dosyaya kopyalayabiliyorum.
Örn: Excelde "A" sütununa resim isimlerini girerek kopyalayabiliyorum.

Fakat yazdığım bazı resim isimlerinden olmayadabiliyor ve program doğal olarak bu hataları atlıyor hocalar, sizden ricam aşağıda vereceğim yarım kalan hata raporu veren programı bana revize edebilirmisiniz.
Kodlar çalışıyor fakat yanlış rapor veriyor, resimleri kopyaladığı halde kopyalanan resim isimlerini rapor ediyor.

Şimdiden teşekkürler, Saygılar..

Kod:
Dim DosyaSistemi
dim hata as boolean,aktif as worksheet
set aktif = activesheet
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
veriKlasor = "C:\Users\Halil\Desktop\PACKING  LIST.PRO\Resimlerim\"
hedefKlasor = "C:\Users\Halil\Desktop\resi\"
On Error Resume Next

sheets.add.name="Rapor"
with sheets("Rapor")
     .range("a1").value= "Resim Adı"
     .range("b1").value = "Sonuç"
end with
For i = 1 To aktif.[a65536].End(3).Row
Dosya = veriKlasor & aktif.Cells(i, 1).Value & ".jpg"
If CreateObject("Scripting.FileSystemObject").FileExists(Dosya) = True Then
DosyaSistemi.CopyFile Dosya, hedefKlasor & aktif.Cells(i, 1).Value & ".jpg"

if err then
hata=1
with sheets("Rapor")
     .range("a65536").end(3)(2,1).value = aktif.Cells(i, 1).Value & ".jpg"
     .range("a65536").end(3)(1,2).value = "Bulunamadı".
end with
err.clear
end if

End If
Next i

if hata=0 then
application.displayalerts=false
sheets("Rapor").delete
application.displayalerts=true
else
sheets("Rapor").select
end if
 
Üst