Klasördeki Dosya İsimlerini Listeleme/Değiştirme

[konas06]

Arşivlik kaynak olmuş, katkı sağlayan herkesin eline sağlık.

 

[eengcag]

Merhaba Arkadaşlar

Benzer bir sorunda ben yaşıyorum,Yardımcı olabilirseniz çok sevinirim,
Basit bir otomasyon ile bir web safasında hergün bir kaçtane exel dosya indiyorum.
Bu indirdiğim dosyaların isimleri aşağıdaki şekilde geliyor,fakat her indirdiğimde dosya isminin içindeki numaralar değişiyor."yani dosya ismi değişmiş oluyor.

generatorFuelLevel_202003100038_Tcencaglar_.xls
generators_Tcencaglar_132282635307675948.xls
rectifiers_Tcencaglar_132282635193476184.xls

İhtiyacım olan Macro : Dosyaların isimlerini değiştirerek sabit bir formata çevirmesi,
1-Dosyalar daima Downloads klasörüne iniyor,Yol sabit olacak Macro dosya yerini sormamalı.
2-Dosya isimlerindeki metinleri okumalı sayıları yok sayarak yeni dosya ismini metinlerin birleşimi olarak vermeli veya Kırmızı renkte işaretlediğim kadarını yeni dosya ismi olarak verse çok daha güzel olur.

Umarım açıklayıcı oluştur,Şimdiden desteğiniz için teşekkürler.

 

[asdsxx]

Arkadaşlar Halit3 Bey uzun zamandır formda görünmüyor. Bu mesajımı Halit Bey görür mü bilmem ama ben bir ricam olacak 42. mesajdaki dosyada bulunan kodlarda bir değişiklik yapılabilir mi acaba ben biraz uğraştım işin içinden çıkamadım.
Değişiklik olmasını istediğim şu:
Şu anki durumda A sütununda dosya yolu: Klasör-(varsa alt klasör) ve dosya adı ve uzantısı, B sütununda ise dosyanın adı var.
Olmasını istediğim ise;
A sütununda dosyanın klasör veya alt klasör yolu olup B sütununda ise dosya adı ve dosyanın uzantısı olmasını istiyorum. Yani A sütununda dosya adı ve uzantısı kısmının kalması.

Kod:

Private Sub Liste4(yol As String)
Dim fL As Object, fs As Object, f As Object, j As Long
Set fL = CreateObject("Scripting.FileSystemObject")


For Each Dosya In fL.GetFolder(yol).Files
j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:A" & Rows.Count)) + 1
Cells(j, 1) = Dosya

Cells(j, 2) = "'" & Format(sayıayır(fL.GetBaseName(Dosya.Name)), "000000000000000")
Next

On Error GoTo sonraki
For Each f In fL.GetFolder(yol).subfolders
Liste4 (f.Path)
sonraki:
Next

End Sub

 

[ÖmerBey]

Aşağıdaki gibi mi istiyorsunuz?

Cells(j, 1) = fL.GetParentFolderName(dosya)

Cells(j, 2) = fL.GetFileName(dosya)

 

[asdsxx]

Aşağıdaki gibi mi istiyorsunuz?

Cells(j, 1) = fL.GetParentFolderName(dosya)

Cells(j, 2) = fL.GetFileName(dosya)

Ömer Bey benim istediğim A sütununda dosyanın bulunduğu klasörleri tam yolunu göstersin B sütununda ise Dosyanın adını ve uzantısını göstersin
Aşağıdaki örnekte A sütununda dosyanın tam Adresi gösteriliyor. Ben dosya kısmına kadar olan dizin ve klasörler (iç içe kaç tane alt klasör varsa) görünsün B sütununda ise sadece Dosyanın adı ve uzantısı görünsün

 

[Korhan Ayhan]

Linki inceleyiniz.

excel alt klasörlerden satırlara dosya listesi

Merhaba Elimde barkod numaralarıyla klasörler ve bu klasörlerde görseller var ve adet çok fazla a1 hücresine klasör adı b1 hücresine bu klasördeki dosya1 , c1 hücresine bu klasördeki dosya2 ...... a2 hücresine klasör adı b2 hücresine bu klasördeki dosya1 , c2 hücresine bu klasördeki dosya2...

www.excel.web.tr

Ekte ise daha sade bir çalışma bulunmaktadır. Klasör ve dosyalara link eklemektedir.

 

[asdsxx]

Linki inceleyiniz.

excel alt klasörlerden satırlara dosya listesi

Merhaba Elimde barkod numaralarıyla klasörler ve bu klasörlerde görseller var ve adet çok fazla a1 hücresine klasör adı b1 hücresine bu klasördeki dosya1 , c1 hücresine bu klasördeki dosya2 ...... a2 hücresine klasör adı b2 hücresine bu klasördeki dosya1 , c2 hücresine bu klasördeki dosya2...

www.excel.web.tr

Ekte ise daha sade bir çalışma bulunmaktadır. Klasör ve dosyalara link eklemektedir.

Korhan Bey Çok teşekkürler...
Tam istediğim gibi olmuş. Hatta tıklatınca ilgili dosyanın açılması ise süper...
Ellerine sağlık.

 

[ahmettalha]

Herkese selamlar,
Sadece dosya isimlerini değil de, excel dosyalarını içindeki sayfa isimleri ile birlikte listeleyen bir makro var mıdır?

 

[Korhan Ayhan]

Excel dosyaları için hazırladığım dosyayı deneyebilirsiniz.

 

[ahmettalha]

Excel dosyaları için hazırladığım dosyayı deneyebilirsiniz.

Bu dosya işimi görür, çok teşekkür ederim. Allah razı olsun

 

[Believing]

Sayın Korhan bey,

Ellerinize, emeğinize ve bilginize sağlık.
Her iki çalışma gerçekten çok profesyonelce olmuş.

Saygılarımla,

 

[ahmettalha]

Excel dosyaları için hazırladığım dosyayı deneyebilirsiniz.

Dosya işimi görür demiştim ama devamını getiremedim. Listelenen excel dosyalarının sayfalarındaki n107 hücresinin değerinin yazdırmaya çalışıyorum ama beceremedim. Her excel dosyasında 1 adet sayfa var.

 

[Korhan Ayhan]

Benim önerdiğim dosyada bu tarz değişikliği yapabilmeniz için temel ADO ve VBA bilgisine sahip olmanız gerekir.

Ekli dosyayı inceleyiniz.

 

[seckinb]

Bu dinamik object'ler gerçekten zor ama bir o kadar da faydalı.

 

[anemis]

Merhaba,
Aşağıdaki örnek kodlar da benim yoğurt yiyişim

Bu Kod Dizini Bulur ve A1 hücresine dizin adını yazar.

Sub DosyaYoluBul()

    Dim fd As FileDialog
    Dim vrtSelectedItem As Variant

    Set fd = Application.FileDialog(msoFileDialogFolderPicker)

    With fd

        If .Show = -1 Then

            For Each vrtSelectedItem In .SelectedItems
                Range("A1") = vrtSelectedItem & Application.PathSeparator
                Liste Range("A1").Text
            Next vrtSelectedItem
          
        End If
      
    End With

    Set fd = Nothing

End Sub

Bu kod Bulunan Dizindeki Dosyaları Listeler, Otomatik çağrılır, ilk kod bunu yapar.

Sub Liste(Yol As String)

    Dim dosya As String, i As Long

    Application.ScreenUpdating = False
    i = Cells(Rows.Count, "A").End(3).Row
    If i < 2 Then i = 2
    Range("A2:B" & i).ClearContents
  
    dosya = Dir(Yol & "*.*")
    i = 1
    While dosya <> ""
        DoEvents
        i = i + 1
        Cells(i, 1) = dosya
        dosya = Dir
    Wend
  
End Sub

Aşağıdaki kodlar ise A sütununda listelenen (Uzantıları ile birlikte) B sütunundaki yeni adı ile değiştirilir. Yeni adı yazarken uzantıyı yazmaya gerek yok, çünkü A sütunundan uzantıyı otomatik olarak alır. B sütunundaki hücre boş ise karşılığındaki A sütunundaki dosyada değişiklik yapmaz.

Sub Degistir()

    Dim DsyBas  As String, _
        i       As Long, _
        j       As Integer, _
        Adt     As Integer, _
        Uzn     As String, _
        Uzanti  As String, _
        Yol     As String
          
    Uzn = Application.InputBox("Uzantısı Olmayan Dosyaların Uzantısı Ne Olsun?", "Sordum Gitti Valla", ".mp4", Type:=2)
  
    Yol = Application.WorksheetFunction.Trim(Range("A1"))
    If Not Right(Yol, 1) = "\" Then Yol = Yol & Application.PathSeparator
  
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
  
        If Not Cells(i, "B") = "" Then
      
            Adt = Adt + 1
            j = InStr(1, StrReverse(Cells(i, "A")), ".", vbTextCompare)
            If j > 0 Then
                Uzanti = Right(Cells(i, "A"), j)
            Else
                Uzanti = Uzn
            End If
              
            Name Yol & Cells(i, "A") As Yol & Cells(i, "B") & Uzanti
          
        End If
      
    Next i
  
    MsgBox Adt & " ADET DOSYA ADI DEĞİŞTİRİLDİ...", vbInformation, "NECDET YEŞERTENER"
  
End Sub

Sayın hocam merhaba.

Öncelikle çok uzun süre önce atılmış olan mesajı alıntılayarak "hortlattığım" için kusura bakmayınız. Tam aradığım ve bana lazım olan bir kod çalışması olmuş. Ellerinize sağlık.

Çok ufak bir güncelleme rica edeceğim sizden; açıkçası kendim uğraştım ancak kod bilgim o kadar fazla olmadığından beceremedim.

Paylaşmış olduğunuz en son kod dizisinde ( Sub Degistir() ) dosyaların isimlerini değiştirmeden önce klasör seçimi eklenebilir mi?

İhtiyacım şu yönde;

Bir klasör içerisinde 50 adet dosya var diyelim ki. Bu dosyanın içerisindeki klasörlerin dosya uzantıları .dwg şeklinde. Bu isimleri alarak (ki paylaşmış olduğunuz ilk iki kod bu işlemi harika bir şekilde yapıyor tekrar teşekkürler) farklı bir klasör içerisindeki PDF uzantılı dosyaların isimleri ile değiştirmek istiyorum. Bu nedenle B satırına yazılacak isimleri değiştirmek istediğimde yeniden ikinci bir klasörü seçmem gerekiyor.

Umarım yardımcı olabilirsiniz. Tekrar teşekkür ederim.