Dosya Ismi Degistirme

[taner3106]

Arkadaslar elimdeki "E:\X" klasörünün altinda 7000 civari altklasör var. Herbir altklasörün icinde o altklasörün ismiyle kayitli bir excel dosyasi var. Bu Excel dosyalarinin isimlerini degistirmem gerekiyor. Bu dosyalarin yeni isimlerini su sekilde degistirebilir miyiz?

dosyanin icinde bulundugu altklasörün isminin ilk 3 harfi ve son 3 harfini birlestirerek türetilen yeni isim

o kadar aradim ama bulduklarim tam bana lazim olan degil. kendime göre de bir türlü uyarlayamadim. simdiden tesekkürler arkadaslar.

 

[halit3]

Arkadaslar elimdeki "E:\X" klasörünün altinda 7000 civari altklasör var. Herbir altklasörün icinde o altklasörün ismiyle kayitli bir excel dosyasi var. Bu Excel dosyalarinin isimlerini degistirmem gerekiyor. Bu dosyalarin yeni isimlerini su sekilde degistirebilir miyiz?

dosyanin icinde bulundugu altklasörün isminin ilk 3 harfi ve son 3 harfini birlestirerek türetilen yeni isim

o kadar aradim ama bulduklarim tam bana lazim olan degil. kendime göre de bir türlü uyarlayamadim. simdiden tesekkürler arkadaslar.

Kod:

Sub Dosya_isimlerini_degistir()

Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla

Liste (Kaynak)
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Private Sub Liste(yol As String)
Dim fs As Object, f As Object
Set fs = CreateObject("Scripting.FileSystemObject")
For Each dosya In fs.GetFolder(yol).Files
eski = dosya
yeni = yol & "\" & Left(fs.GetBaseName(dosya), 3) & Right(fs.GetBaseName(dosya), 3) & "." & fs.GetExtensionName(dosya)
MsgBox eski & Chr(10) & yeni
Name eski As yeni
Next
On Error GoTo sonraki
For Each f In fs.GetFolder(yol).subfolders
Liste (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub

 

[taner3106]

Sn Halit tesekkur ederim cevabin icin.
Yazmis oldugun kod dosyanin eski ismini baz alarak yeni isim olusturuyor. Benim ihtiyacim olan dosyanin bulundugu klasoru baz alarak yeni isim olusturmasi.
- Unzip klasörünün altinda yaklasik 7000 tane "thb & tarih & seans" formatinda klasörler bulunmakta.
- Bu "thb & tarih & seans" formatindaki klasorlerin her birinin icinde sadece bir tane dosya bulunmakta. Bu dosya "TBULT_S & seans" formatindaki isim altinda excel dosyasi.

istedigim:
- E:\Bist Verileri\Unzip\thb200101021 altinda kayitli "TBULT_S1.XLS" dosyasinin adini "02 01 2001 1.xls" olarak,

- E:\Bist Verileri\Unzip\thb200101022 altinda kayitli "TBULT_S2.XLS" dosyasinin adini "02 01 2001 2.xls" olarak,

- E:\Bist Verileri\Unzip\thb200101031 altinda kayitli "TBULT_S1.XLS" dosyasinin adini "03 01 2001 1.xls" olarak,

- E:\Bist Verileri\Unzip\thb200101032 altinda kayitli "TBULT_S2.XLS" dosyasinin adini "03 01 2001 2.xls" olarak degistirmek.

Tesekkurlerimi sunuyorum.

 

[halit3]

Sn Halit tesekkur ederim cevabin icin.
Yazmis oldugun kod dosyanin eski ismini baz alarak yeni isim olusturuyor. Benim ihtiyacim olan dosyanin bulundugu klasoru baz alarak yeni isim olusturmasi.
- Unzip klasörünün altinda yaklasik 7000 tane "thb & tarih & seans" formatinda klasörler bulunmakta.
- Bu "thb & tarih & seans" formatindaki klasorlerin her birinin icinde sadece bir tane dosya bulunmakta. Bu dosya "TBULT_S & seans" formatindaki isim altinda excel dosyasi.

istedigim:
- E:\Bist Verileri\Unzip\thb200101021 altinda kayitli "TBULT_S1.XLS" dosyasinin adini "02 01 2001 1.xls" olarak,

- E:\Bist Verileri\Unzip\thb200101022 altinda kayitli "TBULT_S2.XLS" dosyasinin adini "02 01 2001 2.xls" olarak,

- E:\Bist Verileri\Unzip\thb200101031 altinda kayitli "TBULT_S1.XLS" dosyasinin adini "03 01 2001 1.xls" olarak,

- E:\Bist Verileri\Unzip\thb200101032 altinda kayitli "TBULT_S2.XLS" dosyasinin adini "03 01 2001 2.xls" olarak degistirmek.

Tesekkurlerimi sunuyorum.

1 nolu mesajınızdaki soru farklı 3 nolu mesajınızdaki soru farklı
anlaşılan soru değişmiş.

Aşağıdaki kodu çalıştır.
Klasöre göz at liste kutusundan dosyaların bulunduğu klasörü seç ve tamam tıkla

kod:

Sub Dosya_isimlerini_degistir()

Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla

Liste (Kaynak)
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Private Sub Liste(yol As String)
Dim fs As Object, f As Object
Set fs = CreateObject("Scripting.FileSystemObject")
For Each dosya In fs.GetFolder(yol).Files

deg1 = Mid(fs.GetBaseName(fs.GetParentFolderName(dosya)), 10, 2) & " "
deg2 = Mid(fs.GetBaseName(fs.GetParentFolderName(dosya)), 8, 2) & " "
deg3 = Mid(fs.GetBaseName(fs.GetParentFolderName(dosya)), 4, 4) & " "
deg4 = Right(fs.GetBaseName(fs.GetParentFolderName(dosya)), 1)

If Right(Kaynak, 1) <> "\" Then Kaynak = Kaynak & "\"
yeni = yol & "\" & deg1 & deg2 & deg3 & deg4 & "." & fs.GetExtensionName(dosya)
Name dosya As yeni
Next
On Error GoTo sonraki
For Each f In fs.GetFolder(yol).subfolders
Liste (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub

 

[taner3106]

Sayin Halit
Ilgin ve alakan icin cok tesekkür ederim. Aslinda sorum degismemisti. Basit olsun diye 1 nolu mesajda ilk 3 ve son 3 harfleri demistim. Orasini kendime sonradan uyarlamayi dusunmustum. Dosya adinin baz alinacagi yer tam net olarak anlasilmayinca istedigimi tam olarak yazdim. Calismalarinizda kolayliklar ve basarilar diliyorum.