Klasörün içindeki dosyaları açmadan sayfa adlarını değiştirme.

[Carpintero]

Merhabalar iyi günler.

"Stoklar" adlı klasörün içinde muhtelif isimlerle kayıtlı dosyalar
mevcut. Ahmet, Mehmet, Ali Veli gibi. Bütün dosyalarda 1 er tane
sayfa var ve bu sayfaların isimleri de farklı yine dosya adlarında olduğu gibi.

Ben bu dosyaları hiç açmadan (aç kapa yapmadan )
tamamının adını belirlediğim bir isimle örneğin "2014" ile değiştirmek
istesem bunu yapacak kod yazılabilir mi acaba? Eğer mümkün ise yardımlarınızı
bekliyorum. Açıklama noksan ise örnek dosya ekleyebilirim.

İyi haftasonları.

 

[Murat OSMA]

Seçilen dosyadaki istenilen sayfa adını değiştirmek için;

[FONT="Trebuchet MS"]Private Sub Commandbutton1_Click()
    Bul_Değiştir TextBox1.Text, ComboBox1.Text, TextBox2.Text
End Sub

Sub Bul_Değiştir(ByVal Dosya As String, Sayfa As String, Yeni As String)
    On Error GoTo Hata
    Dim Rky As Object
    If Len(Dir(Dosya)) = 0 Then
       MsgBox "..::.. Dosya bulunamadı ..::..", vbCritical, "Www"
        Exit Sub
    End If
    Me.MousePointer = vbHourglass
    Set Rky = CreateObject("Excel.Application")
    Rky.Workbooks.Open Dosya
    Rky.Visible = False
    Rky.ActiveWorkbook.Sheets(Sayfa).Name = Yeni
    Rky.ActiveWorkbook.Save
    Rky.Quit
    Set Rky = Nothing
    Me.MousePointer = 0
    MsgBox "..:... Değiştirildi ..::.. ", vbInformation, "Www"
    Exit Sub
Hata:
    MsgBox Err.Description
    On Error Resume Next
    Rky.Quit
    Set Rky = Nothing
    Me.MousePointer = 0
End Sub

Private Sub CommandButton2_Click()
    dsy = Application.GetOpenFilename(FileFilter:="Excel Dosyaları,*.xls;*.xlsx;*.xlsm", Title:="Dosya Seç")
    If dsy = "" Or dsy = False Then Exit Sub
    TextBox1.Value = dsy
    Dim Rky As Object, Ert As Object, Cat As Object, Sayfa As Object
    Set Rky = CreateObject("adodb.connection")
    Set Ert = CreateObject("adodb.recordset")
    Set Cat = CreateObject("adox.catalog")
    Set Sayfa = CreateObject("adox.table")
    Application.ScreenUpdating = False
    Rky.Open "provider=microsoft.ace.oledb.12.0;data source=" & dsy & ";extended properties=""excel 12.0;hdr=no"""
    Cat.ActiveConnection = Rky
    For Each Sayfa In Cat.Tables
        ComboBox1.AddItem Replace(Sayfa.Name, "$", "")
    Next Sayfa
    Set Rky = Nothing: Set Ert = Nothing: Set Cat = Nothing: Set Sayfa = Nothing
End Sub[/FONT]

 

[Carpintero]

Murat abi merhaba. Çok teşekkür ederim.
Elinize sağlık.

Kodu belirli periyotlarla sürekli kullanacağım için, Textboxla Dosya adı sayfa adı sorması
işlemi bayağı bayağı uzatıyor.

Kodu şu şekilde yapabilir misiniz acaba?

Kodu çalıştırdığımız Kitabın "A1" hücresine "2014" yazmış olalım.
Komut verildiği anda; Kod aşağıdaki "Stoklar" klasörünün içinde bulunan bütün çalışma kitaplarındaki
tüm dosyaların sayfa adlarını "2014" yapsın. Bize herhangi birşey sormadan.
(Her kitapta tek 1 tane sayfa var)
"C:\Documents and Settings\efe2005\Desktop\Stoklar"

 

[Murat OSMA]

Bu kodları kullanabilirsin;

[FONT="Trebuchet MS"]Sub Emre()
    Dim fso As Object, Rky As Object, dosya As Workbook, yol$
    Set fso = CreateObject("Scripting.FileSystemObject")
    yol = "C:\Documents and Settings\efe2005\Desktop\Stoklar"
    Application.ScreenUpdating = False
    For Each Rky In fso.getfolder(yol).Files
        Set dosya = Workbooks.Open(Rky)
        dosya.Sheets(1).Name = ThisWorkbook.ActiveSheet.Range("A1").Value
        dosya.Close True
    Next Rky
    Application.ScreenUpdating = True
    Set fso = Nothing: Set Rky = Nothing: Set dosya = Nothing: yol = ""
End Sub[/FONT]

 

[Carpintero]

Murat abi teşekkür ederim.

Kod yapacağı işlemi noksansız yapıyor.
Bu işlemi yaparken dosyaların hiçbir surette açılmaması gerekiyor.
Bu kısmı çok önemli. Bu imkanımız var mı acaba.

 

[Murat OSMA]

Yaparım ama şimdi çıkmam gerek. Malûm akşam maç var.
Gelince bakarım olur mu ?

 

[Carpintero]

Tamam Murat abi saygılar.