• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Klasör İçindeki Dosya Adının Excele Yazdırılması

Katılım
17 Ocak 2007
Mesajlar
193
Excel Vers. ve Dili
Office 365
İyi akşamlar,
Ütopik birşey mi bilmiyorum ancak a.xls diye bir excel kitabımız var ve a adlı klasörümüz var, a klasörü içerisine kaydettiğimiz excel kitaplarının isimlerini a.xls kitabının a1 hücresinden başlayarak a2, a3 hücrelerine sıra ile yazdırabilir miyiz? yani a kalasörüne kaydettiğimiz kitap isimlerinin adları yazılabilir mi?
 
İyi akşamlar,
Ütopik birşey mi bilmiyorum ancak a.xls diye bir excel kitabımız var ve a adlı klasörümüz var, a klasörü içerisine kaydettiğimiz excel kitaplarının isimlerini a.xls kitabının a1 hücresinden başlayarak a2, a3 hücrelerine sıra ile yazdırabilir miyiz? yani a kalasörüne kaydettiğimiz kitap isimlerinin adları yazılabilir mi?
A klasörü excel dosyamızın bulundu ğu klasörün içindeki bir alt klasörmü?
 
Evet az önceki deneme klasörü gibi
Dosayanız ektedir.:cool:
Kod:
Sub dosya_al()
Dim fso As Object, fs As Object, sat As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Range("A:A").ClearContents
For Each fs In fso.getfolder(ThisWorkbook.Path & "\a").Files
    sat = sat + 1
    Cells(sat, "A").Value = fs.Name
Next
MsgBox "Dosyalar A sütununa yazıldı."

End Sub
 

Ekli dosyalar

İyi akşamlar,
Ütopik birşey mi bilmiyorum ancak a.xls diye bir excel kitabımız var ve a adlı klasörümüz var, a klasörü içerisine kaydettiğimiz excel kitaplarının isimlerini a.xls kitabının a1 hücresinden başlayarak a2, a3 hücrelerine sıra ile yazdırabilir miyiz? yani a kalasörüne kaydettiğimiz kitap isimlerinin adları yazılabilir mi?

klasörünüz C:\ diskinizde olarak hazırladım..


Kod:
Sub Dosya_İsimleri()
Dim ds, dc, f, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("C:\a")
Set dc = f.Files
For Each dosya In dc
c = c + 1
Cells(c, 1) = dosya.Name
Next
End Sub
 
Dosayanız ektedir.:cool:
Kod:
Sub dosya_al()
Dim fso As Object, fs As Object, sat As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Range("A:A").ClearContents
For Each fs In fso.getfolder(ThisWorkbook.Path & "\a").Files
    sat = sat + 1
    Cells(sat, "A").Value = fs.Name
Next
MsgBox "Dosyalar A sütununa yazıldı."

End Sub
süper olmuş ben bunu kendime uyarladığımda ne yapmam gerek?
 
Sub dosya_al()
Dim fso As Object, fs As Object, sat As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Range("A:A").ClearContents
For Each fs In fso.getfolder(ThisWorkbook.Path & "\a").Files
sat = sat + 1
Cells(sat, "A").Value = fs.Name
Next
MsgBox "Dosyalar A sütununa yazıldı."

End Sub

eger klasör adını a değilde başka bir isim verecekseniz..klasör adını değişmeniz yeterli olacaktır. kırmızı renkl yeri...
örnek:
Sub dosya_al()
Dim fso As Object, fs As Object, sat As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Range("A:A").ClearContents
For Each fs In fso.getfolder(ThisWorkbook.Path & "\sosorry").Files
sat = sat + 1
Cells(sat, "A").Value = fs.Name
Next
MsgBox "Dosyalar A sütununa yazıldı."

End Sub
 
Dosayanız ektedir.:cool:
Kod:
Sub dosya_al()
Dim fso As Object, fs As Object, sat As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Range("A:A").ClearContents
For Each fs In fso.getfolder(ThisWorkbook.Path & "\a").Files
    sat = sat + 1
    Cells(sat, "A").Value = fs.Name
Next
MsgBox "Dosyalar A sütununa yazıldı."

End Sub

sizden aldığım yardımlarla ekteki dosyayı hazırladım. buraya nasıl uyarlayabilirim? sadece xlslerin yazılmasını istiyorum çünkü sts nin içinde pdfler de olacak. bir de bu klasör içerisinde userform kullanılmadan değişiklik yapmayı nasıl engelleyebilirim?
 

Ekli dosyalar

Hem xls hemde xlsx dosyalarını lidsteteler.
Kendinize uyarlayın.:cool:
Kod:
Sub dosya_al()
Dim fso As Object, fs As Object, sat As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Range("A:A").ClearContents
For Each fs In fso.getfolder(ThisWorkbook.Path & "\a").Files
    If Right(fs.Name, 4) = ".xls" Or Right(fs.Name, 5) = ".xlsx" Then
        sat = sat + 1
        Cells(sat, "A").Value = fs.Name
    End If
Next
MsgBox "Dosyalar A sütununa yazıldı."

End Sub
 
Hem xls hemde xlsx dosyalarını lidsteteler.
Kendinize uyarlayın.:cool:
Kod:
Sub dosya_al()
Dim fso As Object, fs As Object, sat As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Range("A:A").ClearContents
For Each fs In fso.getfolder(ThisWorkbook.Path & "\a").Files
    If Right(fs.Name, 4) = ".xls" Or Right(fs.Name, 5) = ".xlsx" Then
        sat = sat + 1
        Cells(sat, "A").Value = fs.Name
    End If
Next
MsgBox "Dosyalar A sütununa yazıldı."

End Sub

sanırım yaptım çok teşekkür ederim :) :) az önce sorduğum çift tıklama sonuna xls yazıldığı için çalışmıyor ondan nasıl bir düzenleme yapabilirim? bir de a1 değil de a2den çaşlamasını nasıl sağlarım :)
 
Son düzenleme:
sanırım yaptım çok teşekkür ederim :) :) az önce sorduğum çift tıklama sonuna xls yazıldığı için çalışmıyor ondan nasıl bir düzenleme yapabilirim? bir de a1 değil de a2den çaşlamasını nasıl sağlarım :)
2nci satırdan başlamısı için böyle yapın.Diğer konuyu anlamdım.xls dosyasını listelemesi lazım böyle
Kod:
Sub dosya_al()
Dim fso As Object, fs As Object, sat As Long
Set fso = CreateObject("Scripting.FileSystemObject")
sat=1
Range("A:A").ClearContents
For Each fs In fso.getfolder(ThisWorkbook.Path & "\a").Files
    If Right(fs.Name, 4) = ".xls" Or Right(fs.Name, 5) = ".xlsx" Then
         Cells(sat, "A").Value = fs.Name
         sat = sat + 1
    End If
Next
MsgBox "Dosyalar A sütununa yazıldı."

End Sub
 
2nci satırdan başlamısı için böyle yapın.Diğer konuyu anlamdım.xls dosyasını listelemesi lazım böyle
Kod:
Sub dosya_al()
Dim fso As Object, fs As Object, sat As Long
Set fso = CreateObject("Scripting.FileSystemObject")
sat=1
Range("A:A").ClearContents
For Each fs In fso.getfolder(ThisWorkbook.Path & "\a").Files
    If Right(fs.Name, 4) = ".xls" Or Right(fs.Name, 5) = ".xlsx" Then
         Cells(sat, "A").Value = fs.Name
         sat = sat + 1
    End If
Next
MsgBox "Dosyalar A sütununa yazıldı."

End Sub
yok yok listeliyor da az önceki konuda sorduğum çift tıklama ile açma var ya listelediğinde .xls yi de yazdığı için çift tıklandığında dosya bulunamadı diyor :S
 
yok yok listeliyor da az önceki konuda sorduğum çift tıklama ile açma var ya listelediğinde .xls yi de yazdığı için çift tıklandığında dosya bulunamadı diyor :S
Anlamadım kaçıncı mesaj.Çalışıyorduda şimdimi çalışmıyor ne oldu.daha detaylı açıklama lazım.:cool:
 
Dosyanız ektedir.:cool:
Kod:
Sub dosya_al()
Dim fso As Object, fs As Object, sat As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Range("A:A").ClearContents
For Each fs In fso.getfolder(ThisWorkbook.Path & "\a").Files
    If Right(fs.Name, 4) = ".xls" Then
        sat = sat + 1
        Cells(sat, "A").Value = Left(fs.Name, Len(fs.Name) - 4)
    End If
Next
MsgBox "Dosyalar A sütununa yazıldı."

End Sub
 

Ekli dosyalar

Dosyanız ektedir.:cool:
Kod:
Sub dosya_al()
Dim fso As Object, fs As Object, sat As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Range("A:A").ClearContents
For Each fs In fso.getfolder(ThisWorkbook.Path & "\a").Files
    If Right(fs.Name, 4) = ".xls" Then
        sat = sat + 1
        Cells(sat, "A").Value = Left(fs.Name, Len(fs.Name) - 4)
    End If
Next
MsgBox "Dosyalar A sütununa yazıldı."

End Sub
çok teşekkür ederim süper oldu zaten bugün 1-2 soru daha sorsam sanırım uçcaksınız bana ben yarın devam ediyim o zaman çok teşekkür ederim.
 
çok teşekkür ederim süper oldu zaten bugün 1-2 soru daha sorsam sanırım uçcaksınız bana ben yarın devam ediyim o zaman çok teşekkür ederim.
Siz sorunuzu sorun .Başka arkadaşlarda yaparlar.Hepsini ben yapacak değilim ya.Beklki bende yaparım.
Kolay gelsin.:cool:
 
Merhaba bende klasör içindeki dosyaları excele almak ıstıyorum yardımınıza ıhtıyacım var..
 
Konuyla ilgili ben de soru soracam..

Bu yapılan işlemlerde dosyalar excel yerine başka dosyalar olabilir Mi?
bir de devamında dosyalar yerine klasör isimleri olarak eklenebilir mi?

Teşekkkürler..
Selamlar..
 
Geri
Üst