Belirli İsme Sahip Dosyaları Klasörden Ayırmak

[xtrkax]

Merhabalar, sormak istediğim soru şu:
C://Resimler isimli bir dizinde görsellerimin olduğunu varsayalım. Yaklaşık 4bin tane.
Bu klasörde yer alan tüm JPG dosyalarının isimlerini bir excel sutunu (A:A) üzerinde topladım.
Daha sonra yine aynı sutunda sadece ihtiyacım olan dosyaların isimlerini bıraktım. İhtiyacım olmayan 3.5k satırı imha ettim.
Excel dosyamın A1 Sutununda isimleri kayıtlı olan 500 tane dosyayı C://Resimler klasöründen kopyalanıp C://Resimler//1 isimli klasöre (yada bambaşka bir dizindeki klasöre) yapıştırılmasını sağlayabilir miyim? Çok mu zordur?

 

[tamer42]

Merhabalar, sormak istediğim soru şu:
C://Resimler isimli bir dizinde görsellerimin olduğunu varsayalım. Yaklaşık 4bin tane.
Bu klasörde yer alan tüm JPG dosyalarının isimlerini bir excel sutunu (A:A) üzerinde topladım.
Daha sonra yine aynı sutunda sadece ihtiyacım olan dosyaların isimlerini bıraktım. İhtiyacım olmayan 3.5k satırı imha ettim.
Excel dosyamın A1 Sutununda isimleri kayıtlı olan 500 tane dosyayı C://Resimler klasöründen kopyalanıp C://Resimler//1 isimli klasöre (yada bambaşka bir dizindeki klasöre) yapıştırılmasını sağlayabilir miyim? Çok mu zordur?

Merhaba,
Aşağıdaki kod işinizi görecektir, Mevcut ve hedef klasör isimlerini kendiniz düzenleyiniz.

Sub Move_Folder()
    Dim r As Long
    Dim FSO As Object
    Dim SourcePath As String
    Dim DestPath As String
    Dim Fn As String

    SourcePath = "C:\Users\AAAA\"
    DestPath = "C:\Users\BBBB\"
   
    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(Left(SourcePath, Len(SourcePath) - 1)) = False Then
        MsgBox SourcePath & " doesn't exist"
        Exit Sub
    End If

With ActiveSheet
 For r = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row

    Fn = .Cells(r, "A").Value
    FSO.MoveFile Source:=SourcePath & Fn, Destination:=DestPath
    
    Next r
End With

End Sub

 

[xtrkax]

Merhaba,
Aşağıdaki kod işinizi görecektir, Mevcut ve hedef klasör isimlerini kendiniz düzenleyiniz.

Sub Move_Folder()
    Dim r As Long
    Dim FSO As Object
    Dim SourcePath As String
    Dim DestPath As String
    Dim Fn As String

    SourcePath = "C:\Users\AAAA\"
    DestPath = "C:\Users\BBBB\"
  
    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(Left(SourcePath, Len(SourcePath) - 1)) = False Then
        MsgBox SourcePath & " doesn't exist"
        Exit Sub
    End If

With ActiveSheet
For r = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row

    Fn = .Cells(r, "A").Value
    FSO.MoveFile Source:=SourcePath & Fn, Destination:=DestPath
   
    Next r
End With

End Sub

Merhabalar, ilginize çok teşekkür ederim fakat makroyu çalıştırdığım zaman herhangi bir hata almıyor olmama rağmen bir sonuç elde edemiyorum.
A sutunundaki hücre değerlerini dosya ismi ile misal: IMG_3701 veya IMG_3701.JPG şeklinde de denesem de bir sonuç alamadım. Bir yerde hata mı yapıyorum acaba?

 

[tamer42]

Merhabalar, ilginize çok teşekkür ederim fakat makroyu çalıştırdığım zaman herhangi bir hata almıyor olmama rağmen bir sonuç elde edemiyorum.
A sutunundaki hücre değerlerini dosya ismi ile misal: IMG_3701 veya IMG_3701.JPG şeklinde de denesem de bir sonuç alamadım. Bir yerde hata mı yapıyorum acaba?

Sanırım B sütunu boş, Aşağıdaki satırda sütun bilgisini A olarak düzenleyebilirsiniz.

For r = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row

For r = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row

 

[halit3]

Bu dosyayı bir dene