45 bin excel dosyasının herbirine kendi içerisindeki sabir bir hücreden dosya ismi atamak

Katılım
24 Eylül 2022
Mesajlar
12
Excel Vers. ve Dili
2021 ingilizce
Merhaba,

Yaklaşık 45 bin adetlik bir excel dosyam var. Bu dosyaların herbirinin adını, her dosyanın kendi içerisindeki "B9" hücresindeki text ile değiştirmem gerekiyor.

Bunu yapmanın kolay bir yolu var mı acaba?

Yardımcı olabilirseniz sevinirim.
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,082
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
Merhaba,

Bütün dosyalarda B9 hücresinin bulunduğu sayfa adı sabit mi?
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,082
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
Peki B9 hücresinde yazan metin için bir örnek paylaşır mısınız?
 
Katılım
24 Eylül 2022
Mesajlar
12
Excel Vers. ve Dili
2021 ingilizce
aşağıdaki tip ve benzerlerindeler.

KGM/3780/7
KGM/3780/7-M
KGM/3780/7-S
KGM/3780/8
KGM/3780/8-M
KGM/3780/8-S
KGM/3780/9
KGM/3950
KGM/3955
KGM/3960
KGM/3965
KGM/3980
KGM/3985/2A
KGM/40.130
KGM/4100-E1/A
KGM/4100-E1/B
KGM/4100-E2/A
KGM/4100-E2/B
KGM/4100-K/A
KGM/9003/1
KGM/9003/2
RAYİÇ.01
RAYİÇ.02
RAYİÇ.03
04.008/3D
2200
2202
KGM/03.5000
10.240.6751
10.240.6752
10.240.6753
10.240.6754
10.240.6755
10.240.6756
10.240.6757
10.240.6758
10.240.6759
10.240.6771
10.240.6772
10.240.6773
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,082
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
Deneyiniz.

Linkteki dosyada B1 hücresine işlem yapılacak klasör adresini yazınız.

Ek olarak dosya adında kullanılması yasak karakterlerin tümü "_" sembolü ile değiştirildi.

Dosya adı benzer olanlar için dosya adının sonuna 1-2-3 şeklinde artarak devam eden sayaç ekledim.

C++:
Option Explicit

Sub Change_Filenames_in_Folder()
    Dim My_Connection As Object, My_Recordset As Object
    Dim FSO As Object, My_Array As Object, Process_Time As Double
    Dim My_Folder As String, My_File As String, File_Count As Long
    Dim My_File_Name_Old As String, My_File_Name_New As String
    Dim Special_File_Count As Long, Searched_File_Extension As String
   
    Process_Time = Timer
   
    Range("A4").ClearContents
   
    Set My_Connection = VBA.CreateObject("AdoDb.Connection")
    Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
    Set My_Array = VBA.CreateObject("Scripting.Dictionary")

    My_Folder = Range("B1").Value
   
    Searched_File_Extension = "*.xls*"
   
    My_File = Dir(My_Folder & Searched_File_Extension)
   
    While My_File <> ""
        Special_File_Count = Special_File_Count + 1
        My_File = Dir
    Wend
   
    My_File = Dir(My_Folder & Searched_File_Extension)
   
    While My_File <> "" And File_Count < Special_File_Count
        If My_File <> ThisWorkbook.Name Then
            My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
            My_Folder & My_File & ";Extended Properties=""Excel 12.0;Hdr=No"""
            
            Set My_Recordset = My_Connection.Execute("Select * From [Sheet1$B9:B9]")
       
            If My_Recordset.Fields.Item(0).Value <> "" Then
                My_File_Name_Old = My_Folder & My_File
                My_File_Name_New = My_Recordset.Fields.Item(0).Value & "." & FSO.GetExtensionName(My_File)
                My_File_Name_New = Replace(Replace(My_File_Name_New, "/", "_"), "\", "_")
                My_File_Name_New = Replace(Replace(My_File_Name_New, ":", "_"), "*", "_")
                My_File_Name_New = Replace(Replace(My_File_Name_New, "?", "_"), """", "_")
                My_File_Name_New = Replace(Replace(My_File_Name_New, "<", "_"), ">", "_")
                My_File_Name_New = Replace(My_File_Name_New, "|", "_")
                My_File_Name_New = My_Folder & My_File_Name_New
       
                If My_Recordset.State <> 0 Then My_Recordset.Close
                If My_Connection.State <> 0 Then My_Connection.Close
           
                If Not My_Array.Exists(My_File_Name_New) Then
                    My_Array.Add My_File_Name_New, 0
                    If Not FSO.FileExists(My_File_Name_New) Then
                        Name My_File_Name_Old As My_File_Name_New
                    End If
                Else
                    My_Array.Item(My_File_Name_New) = My_Array.Item(My_File_Name_New) + 1
                    My_File_Name_New = My_Folder & FSO.GetBaseName(My_File_Name_New) & "_" & _
                    My_Array.Item(My_File_Name_New) & "." & FSO.GetExtensionName(My_File_Name_New)
                    If Not FSO.FileExists(My_File_Name_New) Then
                        Name My_File_Name_Old As My_File_Name_New
                    End If
                End If
            End If
        End If
       
        My_File = Dir
        File_Count = File_Count + 1
        Range("A4").Value = File_Count
    Wend
   
    My_Array.RemoveAll
   
    Set My_Connection = Nothing
    Set My_Recordset = Nothing
    Set My_Array = Nothing
    Set FSO = Nothing
   
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Process_Time, "0.00") & " Saniye"
End Sub
 

Ekli dosyalar

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,232
Excel Vers. ve Dili
excel 2010
Merhaba

Kodun içinde excel sürüm bilgisi var, bu yüzden hata alıyor olabilirsiniz. Ben denemedim, siz kontrol ediniz.

My_File = Dir(My_Folder & "*.xls*")

My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
My_Folder & My_File & ";Extended Properties=""Excel 12.0;Hdr=No"""

Örneğin benimki Excel 16.0
 
Son düzenleme:

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
14,124
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Yeni dosya adındaki : ve \ ler de _ olarak değiştiği için hata alıyorsunuz.

Alternatif klasik yöntem ile çözüm :
Çalıştırmanız gereken Makro : DizinBul

Kod:
Public Sub DizinBul()

    Dim fd As FileDialog
    Dim vrtSelectedItem As Variant
   
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   

    With fd
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                Dosya_Adini_Degistir (vrtSelectedItem & Application.PathSeparator)
            Next vrtSelectedItem
        Else
            MsgBox "Dizin Belirlemekten Vaz Geçtiniz ........", vbInformation + vbCritical
        End If
       
    End With

    Set fd = Nothing

End Sub
Kod:
Public Sub Dosya_Adini_Degistir(Yol As String)

    Dim Dosya As String
    Dim YeniDosyaAdi As String
    Dim Okunan As Long
    Dim Degistirilen As Long
    Dim Uzanti As String
    Dim d As Variant
   
    Application.ScreenUpdating = False
    Range("A1").CurrentRegion.ClearComments
    Range("A1") = "Dosya Yolu"
    Range("B1") = "Adet"
    Range("C1") = "Eski Dosya Adı"
    Range("D1") = "Yeni Dosya Adı"
   
    On Error Resume Next
    Range("A2") = Yol
   
    Dosya = Dir(Yol & "*.xls*")
   
    While Dosya <> ""
   
        Okunan = Okunan + 1
        Range("b" & Okunan + 1) = Okunan
        Range("C" & Okunan + 1) = Dosya
       
        d = Split(Dosya, ".")
        Uzanti = "." & d(UBound(d))
   
        Workbooks.Open Yol & Dosya
        YeniDosyaAdi = ActiveWorkbook.Sheets(1).Range("B9")
       
        ActiveWorkbook.Close savechanges:=False
       
        Name Yol & Dosya As Yol & YeniDosyaAdi & Uzanti
        If Err.Number = 0 Then
            Degistirilen = Degistirilen + 1
            Range("D" & Okunan + 1) = YeniDosyaAdi
        End If
        Dosya = Dir
       
    Wend

    MsgBox "Okunan " & Okunan & " Adet Dosyadan " & Degistirilen & " Adet Dosya Adı Değiştirildi", vbInformation
       
    Application.ScreenUpdating = True
   
End Sub
 

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,884
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
.

Merhaba,

kaynak değişkenine dosya yolunu yazdıktan sonra kodları çalıştırın.
Orijinal dosyaların yedeğini alın.
Bilgisayarınızda D sürücüsü var ise klasörler bu dizinde olsun.

Kodlar; Sayın Halit3 beyin daha önce paylaştığı kodları revize ettim.

BAT dosyası ile de bir çalışma yaptım ama RAYİÇ gibi Türkçe karakter içeren isimlerde sorun çıkardı.


.
 

Ekli dosyalar

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,082
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
Merhaba,

Necdet beyin bahsettiği durumu düzelttim. Başka iyileştirmelerde yaptım. #7 nolu mesajımdaki kodu bu yönde revize ettim. Ayrıca örnek dosyada paylaştım.

Deneyip işlem süresini bildirirseniz memnun olurum.
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
14,124
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba Korhan bey,

Ado da aynı workbook içinde sayfa kontrolünü genel amaçlı yapabiliyorum ama farklı dosyalardaki sayfa adlarını bilmeyince ado bir işe yaramıyor.
Farklı sayfa olunca kod hata veriyor.
239402
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,082
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
Merhaba Necdet Bey,

Soruyu soran arkadaşımız bütün dosyalarda sayfa adının sabit olduğunu ifade etmişti..

Bununla ilgili olarak linkteki konuları inceleyebilirsiniz.

 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
14,124
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba Korhan bey,

Sayfa adlarının aynı olduğunu atlamışım, Katalog olayını biliyorum ama saçma sapan sayfa adları ürettiği için onu hiç kullanmayı düşünmedim.
Teşekkürler.
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,082
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
Catalog olayında dosyadaki bütün tabloları işleme aldığı için sorguyla kontrol koymakta fayda var. Paylaştığım linklerde benzer kontrol sorguları bulunuyor.
 
Üst