VBA ile Dosyaları Klasörlere Aktarma

[Pirhatap]

Merhaba,

Yeni üyeyim ilk konunun günahı olmaz eğer yazdığım farklı bir yerde yazılıysa affedin ancak çok aradım bulamadım.

Benim sorunum şöyle.

Excel de A sütununda yazılı klasör isimleri belirlediğim hedefte olacak. B satırında da Belirlediğim bir hedefte dosya isimleri olacak. dosya isimlerinin klasör isimlerinden tek farkı " _1" "_2" " _3" şeklinde sonlarında ek olması ve bu dosyalar .jpg dosyaları. Çalıştırıldığında ise B sütunundaki dosyaları A sütunundaki klasörlere kopyalayacak.
Office 2013 kullanıyorum.

Konu hakkında yardımlarınızı rica ederim.

Şimdiden teşekkürler.

 

[askm]

Minik bir örnek ekleyin yardımcı olalım.

 

[Pirhatap]

Cevabınız için teşekkürler.

Örnek aşağıdaki gibidir.

[/url][/IMG]

A sütunu klasör isimleri B sütunu dosya isimleri

 

[askm]

Resmi göremiyorum. Aşağıdaki linkde bir örnek kod eklemiştim. Ondan yola çıkarak işlem yapabilirsiniz.

http://www.excel.web.tr/f48/dosya-kopyalama-ta-yma-t160149.html

 

[Pirhatap]

Resmi göremiyorum. Aşağıdaki linkde bir örnek kod eklemiştim. Ondan yola çıkarak işlem yapabilirsiniz.

http://www.excel.web.tr/f48/dosya-kopyalama-ta-yma-t160149.html

Cevap için teşekkür ederim linkte yer alan kod farklı bir işlem için çok işime yarayacak çok teşekkür ederim. Ancak şu an ki işlem için yeterli bir kod değil.

Şöyle ki...

Hedef klasörün içerisinde yüzlerce klasör var. Bu klasörün adları excelimde A sütununda yazılı.. Hemen karşısında da Yani B sütununda dosya isimleri var.

Kodun şöyle çalışması lazım. Hedef klasöre gidecek. A sütununda yazılı klasör adını bulacak. Sonra gidecek kaynak klasördeki B sütünunda yazan dosyayı alacak bulduğu klasöre kopyalayacak.
A Sütunu---------B Sütunu
6466466204491 6466466204491_1
6466466204491 6466466204491_2
6466466204491 6466466204491_3
6466466204491 6466466204491_4
6466466204491 6466466204491_5
6466466204842 6466466204842_1
6466466204842 6466466204842_2
6466466204842 6466466204842_3
6466466204842 6466466204842_4
6466466204842 6466466204842_5


Görselde de üstteki gibi excel tablosu var

 

[Asri]

Dosya yapınız örnek olarak bu şekilde mi?

Hedef kalsör yapısı

c:\Hedefklasor\
6466466204491
6466466204842

Kaynak dosyaların yapısı

C:\Kaynakklasor\
6466466204491_1
6466466204491_2
6466466204491_3
6466466204491_4
6466466204491_5
6466466204842_1
6466466204842_2
6466466204842_3
6466466204842_4
6466466204842_5

Kopyalancak dosyalar ve hedef kalsörleri

6466466204491 6466466204491_1
6466466204491 6466466204491_2
6466466204491 6466466204491_3
6466466204491 6466466204491_4
6466466204491 6466466204491_5
6466466204842 6466466204842_1
6466466204842 6466466204842_2
6466466204842 6466466204842_3
6466466204842 6466466204842_4
6466466204842 6466466204842_5

 

[Pirhatap]

Dosya yapınız örnek olarak bu şekilde mi?

Hedef kalsör yapısı

c:\Hedefklasor\
6466466204491
6466466204842

Kaynak dosyaların yapısı

C:\Kaynakklasor\
6466466204491_1
6466466204491_2
6466466204491_3
6466466204491_4
6466466204491_5
6466466204842_1
6466466204842_2
6466466204842_3
6466466204842_4
6466466204842_5

Kopyalancak dosyalar ve hedef kalsörleri

6466466204491 6466466204491_1
6466466204491 6466466204491_2
6466466204491 6466466204491_3
6466466204491 6466466204491_4
6466466204491 6466466204491_5
6466466204842 6466466204842_1
6466466204842 6466466204842_2
6466466204842 6466466204842_3
6466466204842 6466466204842_4
6466466204842 6466466204842_5

Aynen öyle tam yazdığınız gibi.

 

[Asri]

Aşağıdaki şekilde deneyiniz.


http://s2.dosya.tc/server3/abuftx/dosya_kopyala.zip.html

Sub dosya_kopayala()
    sonsatir = Cells(Rows.Count, "A").End(3).Row
    
    Columns("C:C").Select
    Selection.ClearContents
    Range("C1").Select
    
    Set ds = CreateObject("Scripting.FileSystemObject")
    For i = 2 To sonsatir
        kaynakyol = "C:\kaynakklasor\" & Cells(i, 2).Value
        hedefyol = "C:\hedefklasor\" & Cells(i, 1).Value & "\" & Cells(i, 2).Value
        varmi = ds.FileExists(kaynakyol)
        If varmi = True Then
           ds.CopyFile kaynakyol, hedefyol
        Else
           Cells(i, 3).Value = "Dosya bulunamadı"
        End If
    Next i
    
    MsgBox ("Kopyalama işlemi tamamlandı")
End Sub

 

[Pirhatap]

Aşağıdaki şekilde deneyiniz.


http://s2.dosya.tc/server3/abuftx/dosya_kopyala.zip.html

Sub dosya_kopayala()
    sonsatir = Cells(Rows.Count, "A").End(3).Row
    
    Columns("C:C").Select
    Selection.ClearContents
    Range("C1").Select
    
    Set ds = CreateObject("Scripting.FileSystemObject")
    For i = 2 To sonsatir
        kaynakyol = "C:\kaynakklasor\" & Cells(i, 2).Value
        hedefyol = "C:\hedefklasor\" & Cells(i, 1).Value & "\" & Cells(i, 2).Value
        varmi = ds.FileExists(kaynakyol)
        If varmi = True Then
           ds.CopyFile kaynakyol, hedefyol
        Else
           Cells(i, 3).Value = "Dosya bulunamadı"
        End If
    Next i
    
    MsgBox ("Kopyalama işlemi tamamlandı")
End Sub

Merhaba,

cevabınız için teşekkür ederim.

Kod hata vermeden çalışıyor ancak dosyalar kaynak klasörde olmasına rağmen dosya bulunamadı hatası veriyor. Sebebi ne olabilir?

Bilgi ricasıyla.

 

[Asri]

Merhaba,

cevabınız için teşekkür ederim.

Kod hata vermeden çalışıyor ancak dosyalar kaynak klasörde olmasına rağmen dosya bulunamadı hatası veriyor. Sebebi ne olabilir?

Bilgi ricasıyla.

Excel deki dosya adları ile kaynak klasördeki dosya adları aynı olmayabilir.
Başında sonunda boşluk, farklı karakter v.b
Hata veren dosya adını kaynak klasörden alıp excel de ilgili yere yapıştırıp dener misiniz?

 

[Pirhatap]

Excel deki dosya adları ile kaynak klasördeki dosya adları aynı olmayabilir.
Başında sonunda boşluk, farklı karakter v.b
Hata veren dosya adını kaynak klasörden alıp excel de ilgili yere yapıştırıp dener misiniz?

Çok teşekkür ederim.

Dosya uzantısını da yazmak gerekiyormuş.

.jpg yazınca buldu ve klasörlerine aktardı.

Ellerinize sağlık.

 

[Asri]

Çok teşekkür ederim.

Dosya uzantısını da yazmak gerekiyormuş.

.jpg yazınca buldu ve klasörlerine aktardı.

Ellerinize sağlık.

Örnek excel dosyalarında dosya adı ne ise ona göre ayarladın.
jpg dosyası ayrıntısını atlamışım