Dosya Taşıma

[askm]

Hayırlı akşamlar.
A3 hücresinde yazılı olan sicil numarası ile alt klasörde "FOTOLAR" klasöründe fotolar mevcut. Kaydı sildiğim zaman o fotoyu "FOTOLAR\SİLİNEN DOSYALAR\" klasörüne taşımak istiyorum.
Aşağıdaki kodu buldum ama bunda tüm fotoları taşıyor. Bunu nasıl sadece a3 e uyarlayabilirim. Teşekkürler.


Option Explicit

Sub Dosya_Taşı()
Dim Dosya_Sistemi As Object, Taşı As Variant
Dim Say As Integer, Uzantı As String
Dim Dosya, Klasör_Yolu_1 As String, Klasör_Yolu_2 As String

Klasör_Yolu_1 = ThisWorkbook.Path & "\FOTOLAR\"
Klasör_Yolu_2 = ThisWorkbook.Path & "\FOTOLAR\silinen fotolar\"

Set Dosya_Sistemi = CreateObject("Scripting.FileSystemObject")

For Each Dosya In Dosya_Sistemi.GetFolder(Klasör_Yolu_1).Files
Uzantı = Split(Dosya.Name, ".")(1)
If UCase(Uzantı) = "JPG" Or UCase(Uzantı) = "JPEG" Then
Say = Say + 1
Taşı = Dosya_Sistemi.MoveFile(Dosya, Klasör_Yolu_2)
If Say = 500 Then GoTo Son
End If
Next

Son:
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ÖmerBey]

Merhaba,
Aşağıdaki şekilde deneyiniz.

Sub Dosya_Taşı()
Dim Dosya_Sistemi As Object, Taşı As Variant
Dim Dosya, Klasör_Yolu_1 As String, Klasör_Yolu_2 As String

Klasör_Yolu_1 = ThisWorkbook.Path & "\FOTOLAR\"
Klasör_Yolu_2 = ThisWorkbook.Path & "\FOTOLAR\silinen fotolar\"

Set Dosya_Sistemi = CreateObject("Scripting.FileSystemObject")

[COLOR="Red"]Dosya = Klasör_Yolu_1 & Range("A3") & ".JPG"[/COLOR]
Taşı = Dosya_Sistemi.MoveFile(Dosya, Klasör_Yolu_2)
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[askm]

Çok teşekkür ederim elinize emeğinize sağlık.