Excel ile dosyaları belirtilen dizine gönderme...

[tucoramirez]

Arkadaşlar merhaba, bir klasördeki bütün dosyaları (Resim 1) Excel'de belirteceğimiz dizine (Resim 2) gönderebiliyor muyuz? Her bir dosya farklı bir dizine gönderilecek.

 

[Ömer]

Merhaba,

Dizinleri nasıl belirliyorsunuz. Aşağıdaki kodlar eski tanımındaki klasördeki resimleri yeni tanımındaki klasöre taşır.

Sub dasya_tasi()
 
    Dim eski As String, yeni As String, dosya As String, d As Object
    
    eski = "C:\resim1\"
    yeni = "C:\resim2\"

    dosya = Dir(eski & "*")
    Set d = CreateObject("Scripting.FileSystemObject")

    Do While dosya <> ""
        d.movefile eski & dosya, yeni & dosya
        dosya = Dir
    Loop

End Sub

 

[tucoramirez]

Merhaba, elimde 3000 adet resim var, hepsi aynı klasörde. Buradaki bütün dosyaları farklı klasörlere taşımak istiyorum.

Örnek:
Kaynak Klasör "C:\masaüstü\resim1\" deki 3000 resmin hepsini farklı klasörlere göndermek istiyorum.

Göndereceğim klasörlerin dizinleri excelde hazırladım.

Hedef: "C:\masaüstü\web gorselleri\anasayfa gorselleri\manset gorselleri\banner

bu şekilde 3000 adet farklı dizine göndermek istiyorum.

Bunu excelde nasıl yapabilirim?

 

[tucoramirez]

Merhaba, elimde 3000 adet resim var, hepsi aynı klasörde. Buradaki bütün dosyaları farklı klasörlere taşımak istiyorum.

Örnek:
Kaynak Klasör "C:\masaüstü\resim1\" deki 3000 resmin hepsini farklı klasörlere göndermek istiyorum.

Göndereceğim klasörlerin dizinleri excelde hazırladım.

Hedef: "C:\masaüstü\V3RESİM\R9650\COLOR PHOTOS\049

bu şekilde 3000 adet farklı dizine göndermek istiyorum.

Bunu excelde nasıl yapabilirim?

Şöyle anlatayım,

Ekli dosyadaki A sütununda dosya yolu belirtilmiş dosyaları B sütunundaki dizine kopyalamak istiyorum. Kopyalamak istediğim dizindeki dosyaların hepsi oluşturulmuş, tek istediğim bu dosyaların belirtilen dizine kopyalanması.

Teşekkür ederim.

 

[Ömer]

Deneyiniz.

Sub dasya_tasi()

    Dim eski As String, yeni As String, i As Long, d As Object, dosya As String
   
    Set d = CreateObject("Scripting.FileSystemObject")
   
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        eski = Cells(i, "A")
        yeni = Cells(i, "B")
        dosya = Split(eski, "\")(UBound(Split(eski, "\")))
        d.movefile eski, yeni & "\" & dosya
    Next i

End Sub

 

[tucoramirez]

Ömer Bey çok teşekkürler, çalıştı.
Beni büyük bir yükten kurtardınız.
Emeğinize sağlık.