Klasör oluşturup dosyaları klasöre taşıma

[izcik]

Merhaba

Örnek veriyorum;
Bilgisayarda F diskimde klasörsüz halde duran yüzlerce dosya var.

Kapıcılar kralı.avi
Esaretin bedeli.mp4
Görünmez adam.mkv
gibi..


Bu dosyaların adlarını (dosya uzantısı olmadan) excelde listeleme imkanımız var.

Excel ile listelenen adlarla aynı adlara sahip boş klasör oluşturmak da mümkün.

Oluşturulan klasörlere, kendi dosyalarını taşıtabilme imkanımız var mıdır? Excel ile bunu yapabilir miyiz?

Yani dosyaları, oluşturduğımuz klasörlerin içine taşıyabilir miyiz?

..

 

[Necdet]

Merhaba,

Bu tür konular forumda baya işlendi.

İNCELEYİNİZ

 

[yunus788]

Merhaba aşağıdaki dosyayı, taşıtmak istediğiniz dosyaların haricinde bir klasöre kopyalayıp çalıştırın. Seçtiğiniz klasördeki dosyaların adıyla klasörler oluşturup ilgili dosyaları taşıyacaktır.
Bir filmin hem kendisini hemde varsa posterini aynı isimle adlandırırsanız, ikisini aynı klasöre taşıyacaktır.

kod

Sub dosyalara_klasor_olustur() 'seçilen klasördeki tüm dosyalara kendi adıyla klasör oluşturup dosyaları içine atar

Set klasorsec = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
yol = klasorsec.Items.Item.Path
Set nesne = CreateObject("Scripting.FileSystemObject")
Set klasor = nesne.GetFolder(yol)
Set dosyalar = klasor.Files
For Each dosya In dosyalar
kl = Split(dosya.Name, "." & nesne.GetExtensionName(dosya.Name))(0)
If nesne.FolderExists(yol & "\" & kl) = False Then nesne.CreateFolder yol & "\" & kl
yer = yol & "\" & kl & "\"
nesne.moveFile Source:=dosya, Destination:=yer
Next
MsgBox "Islem tamam"
End Sub

 

[izcik]

Merhaba aşağıdaki dosyayı, taşıtmak istediğiniz dosyaların haricinde bir klasöre kopyalayıp çalıştırın. Seçtiğiniz klasördeki dosyaların adıyla klasörler oluşturup ilgili dosyaları taşıyacaktır.
Bir filmin hem kendisini hemde varsa posterini aynı isimle adlandırırsanız, ikisini aynı klasöre taşıyacaktır.

kod

Sub dosyalara_klasor_olustur() 'seçilen klasördeki tüm dosyalara kendi adıyla klasör oluşturup dosyaları içine atar

Set klasorsec = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
yol = klasorsec.Items.Item.Path
Set nesne = CreateObject("Scripting.FileSystemObject")
Set klasor = nesne.GetFolder(yol)
Set dosyalar = klasor.Files
For Each dosya In dosyalar
kl = Split(dosya.Name, "." & nesne.GetExtensionName(dosya.Name))(0)
If nesne.FolderExists(yol & "\" & kl) = False Then nesne.CreateFolder yol & "\" & kl
yer = yol & "\" & kl & "\"
nesne.moveFile Source:=dosya, Destination:=yer
Next
MsgBox "Islem tamam"
End Sub

İlginiz için çok teşekkürler. Denemeler yapıp neticeyi arz edeceğim. Sağolun

 

[izcik]

Merhaba aşağıdaki dosyayı, taşıtmak istediğiniz dosyaların haricinde bir klasöre kopyalayıp çalıştırın. Seçtiğiniz klasördeki dosyaların adıyla klasörler oluşturup ilgili dosyaları taşıyacaktır.
Bir filmin hem kendisini hemde varsa posterini aynı isimle adlandırırsanız, ikisini aynı klasöre taşıyacaktır.

kod

Sub dosyalara_klasor_olustur() 'seçilen klasördeki tüm dosyalara kendi adıyla klasör oluşturup dosyaları içine atar

Set klasorsec = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
yol = klasorsec.Items.Item.Path
Set nesne = CreateObject("Scripting.FileSystemObject")
Set klasor = nesne.GetFolder(yol)
Set dosyalar = klasor.Files
For Each dosya In dosyalar
kl = Split(dosya.Name, "." & nesne.GetExtensionName(dosya.Name))(0)
If nesne.FolderExists(yol & "\" & kl) = False Then nesne.CreateFolder yol & "\" & kl
yer = yol & "\" & kl & "\"
nesne.moveFile Source:=dosya, Destination:=yer
Next
MsgBox "Islem tamam"
End Sub

Merhaba Sayın yunus788

Gümüş üye olduğum için paylaştığınız dosyayı indiremedim. Fakat verdiğiniz kodları denedim, istediğim şey tam olarak oldu.

İlginiz için teşekkür ederim.


Sayın yunus788, acaba bu işlemin tam tersini yapacak kodlarımız da var mıdır?

Yani klasörün içinde bulunan dosyaları, klasörsüz hale getirecek kodlar? Arşivimizde dursun.

Teşekkürler, saygılar

 

[yunus788]

Aşağıdaki dosyayı klasörlerin bulunduğu ana dizine kopyalayıp çalıştırın.
Klasörlerdeki dosyaları ana dizine çıkaracaktır.

İndir dosyaları ana dizine taşır

Dosyayı indir dosyaları ana dizine taşır

dosya.co

 

[izcik]

Aşağıdaki dosyayı klasörlerin bulunduğu ana dizine kopyalayıp çalıştırın.
Klasörlerdeki dosyaları ana dizine çıkaracaktır.

İndir dosyaları ana dizine taşır

Dosyayı indir dosyaları ana dizine taşır

dosya.co

Sayın yunus488 harika bir paylaşımda bulundunuz. Çok memnun oldum. Teşekkür ederim, saygılar.

 

[yunus788]

Rica ederim, hepimiz takıldığımız yerde forumdan faydalanıyoruz.