- Katılım
- 4 Haziran 2005
- Mesajlar
- 2,745
- Excel Vers. ve Dili
- 2010-2016
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
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