Klasördeki dosyaları başka bir klasöre taşımak

[hesrefoglu]

Merhaba Bir A klasörü içinde bulunan jpg uzantılı dosyalardan ilk 500 dosyayı B klasörüne taşımak için gerekli makro konusunda yardımlarınızı bekliyorum

 

[Huseyinkis]

Merhaba Bir A klasörü içinde bulunan jpg uzantılı dosyalardan ilk 500 dosyayı B klasörüne taşımak için gerekli makro konusunda yardımlarınızı bekliyorum

Sayın Hesrefoglu A Klasöründeki jpg uzantılı dosyaların kucuk goruntulerini gorebileceğim ve taşınacak ve taşınmayacak şeklinde işaretleme yaparak taşınacak olanların b klasörüne taşıyabileceğim bir makro yapabilirmiyiz diye sorsanız daha iyi olcaktır bence.

Diğer türlü A klosörünü açıp ilk 500 kayıdı secip kes diyerek B klosorune yapıştır yapmak makro yazmaktan daha kısa ve hızlı olur gibi. :kafa:

 

[hesrefoglu]

Ben bu taşıma olayını başka bir işlemin parçası olarak kullanmak istediğim için makro ile yapmak istemiştim.

 

[halit3]

Aşağıdaki linkdeki dosyaya bir bakarmısınız.

http://www.excel.web.tr/f48/resim-gosterme-secenekleri-t90172.html#post491466

 

[hesrefoglu]

Benim yapmak istediğim bu değil.
Bir A klasörü içinde bulunan ismi ne olursa olsun uzantısı jpg olan ilk 500 dosyayı seçip B klasörüne taşımak istiyorum

 

[halit3]

Benim yapmak istediğim bu değil.
Bir A klasörü içinde bulunan ismi ne olursa olsun uzantısı jpg olan ilk 500 dosyayı seçip B klasörüne taşımak istiyorum

Soru ve cevaplarınızda birine soruyorsanız alıntı yaparak cevaplayınız.

Bu soruyu bana soruyorsanız. ekli linkdeki dosyaya bakınız orada bir kaç çeşit userform var o formdan taşıma silme veya değiştirme işlemlerini gerçekleştirebilirsiniz.

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak aşağıdaki kodu denermisiniz. Kırmızı bölümleri kendi sisteminize göre değiştirmeyi unutmayınız.

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 = [COLOR=red]"C:\Documents and Settings\Admin\Desktop\A\"[/COLOR]
    Klasör_Yolu_2 = [COLOR=red]"C:\Documents and Settings\Admin\Desktop\B\"[/COLOR]
 
    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