Klasör içindeki klasör isimlerinin A sütununa listelenmesi

H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Sn Zeki ve Sn Haluk hopcamın kodlarını birleştirerek listelenen dosyanın adı, yolu, boyutu, değiştirilme tatihi gibi özellikleirni aynı anda listelemek istedim ve bunun için AnaListe(213 nolu satır) ve Alt Liste(313 nolu satır) prosodürleriyle kırmızı satırdaki yönlendirmeleri yaptım.

Ancak dosya özellikleri prosodürürünün 403 nolu satırındaki hatanın önüne geçemedim. Ne yapmalıyım?
Kod: 
Public ui As Long
Sub SubHsr_KlasorIceriginiListele()
101    Dim klsrSec, klsrAra, klsrLst As Object
102    Dim klsrMsUstu, dosya, yol As String
103    Set klsrSec = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasor seçin !", 1)
104    klsrMsUstu = CreateObject("WScript.Shell").SpecialFolders("Desktop")
105        If klsrSec = "Masaüstü" Or klasor = "Desktop" Then
106            yol = klsrMsUstu
107            AnaListe (yol)
108            AltListe (yol)
109        ElseIf klsrSec <> "Masaüstü" Then
110            yol = klsrSec.Items.Item.Path
111            AnaListe (yol)
112            AltListe (yol)
113        Else
114            Exit Sub
115        End If
116    Set klsrSec = Nothing
End Sub
Private Sub AnaListe(yol As String)
201 Dim dosya As String
202 Cells.ClearContents
203 Range("A1") = "Dosya Yolu":             Range("B1") = "Dosya Adı":              Range("C1") = "Dosya Tipi"
204 Range("D1") = "Dosya Boyutu":           Range("E1") = "Oluşturulma Tarihi":     Range("F1") = "Son Erişim Tarihi"
205 Range("G1") = "Son Düzenleme Tarihi":   Range("H1") = "Son Düzenleme Zamanı"
206 dosya = Dir(yol & "\*.*")
207 ui = 1
208 While dosya <> ""
209     DoEvents
210     ui = ui + 1
211     Cells(ui, 1) = yol
212     Cells(ui, 2) = dosya
[COLOR=red]213     Call DosyaOzellikleri(yol & dosya)[/COLOR]
214     dosya = Dir
215 Wend
End Sub
Private Sub AltListe(yol As String)
301 Dim klsrAra, klsrLst As Object, dosya, dsyTYl As String
302 Set klsrLst = CreateObject("Scripting.FileSystemObject").GetFolder(yol).SubFolders
303 On Error GoTo sonraki
304 For Each klsrAra In klsrLst
305     dosya = Dir(klsrAra.Path & "\*.*")
306     While dosya <> ""
307        DoEvents
308        ui = [a65000].End(3).Row + 1
309        dsyTYl = yol & "\" & dosya
310        Cells(ui, 1) = yol & "\"
311        Cells(ui, 2) = dosya
312        dosya = Dir
[COLOR=red]313       Call DosyaOzellikleri(yol & "\" & dosya)[/COLOR]
314     Wend
315     AltListe (klsrAra.Path)
316 sonraki:
317 Next
318 Set klsrLst = Nothing
End Sub
Private Sub DosyaOzellikleri(DsyBak As String)
'"D:\TestFolder\TestEmail.xls"
401    Dim fso, myFile As Object
402 Set fso = CreateObject("Scripting.FileSystemObject")
[COLOR=red]403 Set myFile = fso.GetFile(DsyBak)[/COLOR]
404 With myFile
405    Range("C" & ui) = .Type
406    Range("D" & ui) = .Size / 1024 & " Kb"
407    Range("E" & ui) = Format(.DateCreated, "dd.mm.yyyy")
408    Range("F" & ui) = Format(.DateLastAccessed, "dd.mm.yyyy")
409    Range("G" & ui) = Format(.DateLastModified, "dd.mm.yyyy")
410    Range("H" & ui) = Format(.DateLastModified, "hh:mm:ss")
411 End With
412 Set fso = Nothing
413 Set myFile2 = Nothing
End Sub
 
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
g&#252;nayd&#305;n 21. mesaj&#305;m g&#252;ncelli&#287;ini koruyor, sayg&#305;lar&#305;mla.
 
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Ar&#351;imetin dedi&#287;i gibi evreka :)

Kod: 
'______________________________________________________________________________________________________________
'<<=H=>> <<=S=>> <<=A=>> <<=Y=>> <<=A=>> <<=R=>> <<=&#8482;=>> <<==>> <<=www=>> . <<=excel=>> . <<=web=>> . <<=tr=>>|
Public ui As Long                                                                                          '>>|
Sub SubHsr_KlasorIceriginiListele()                                                                        '>>|
'Se&#231;ilen Klas&#246;r&#252;n ve AltKlas&#246;rlerinin i&#231;indeki dosyalar&#305;n yol, isim, de&#287;i&#351;me zaman&#305; gibi &#246;zelliklerini,    '>>|
'aktif &#231;al&#305;&#351;ma sayfas&#305;na yazar.                                                                            '>>|
'Sn. Zeki G&#252;rsoy ve. Sn Haluk'un &#231;al&#305;&#351;malar&#305;ndan Hsayar taraf&#305;ndan derlenmi&#351;tir.                           '>>|
' &#199;al&#305;&#351;mas&#305; i&#231;in AnaListe, AltListe ve Dosya &#214;zellikleri prosod&#252;rlerinin,                                  '>>|
'bu mod&#252;lden silinmemi&#351; olmas&#305; gerekir. :)                                                                 '>>|
Dim soru As String                                                                                         '>>|
10  If Application.Workbooks.Count = 0 Then                                                                '>>|
11      soru = "A&#231;&#305;k &#199;al&#305;&#351;ma Kitab&#305; bulunmamaktad&#305;r, sizin i&#231;in yeni &#231;al&#305;&#351;ma kitab&#305; a&#231;&#305;ls&#305;n m&#305;?"           '>>|
12      If MsgBox(soru, vbYesNo) = vbYes Then                                                              '>>|
13          Workbooks.Add: GoTo 18                                                                         '>>|
14      Else                                                                                               '>>|
15          MsgBox "A&#231;&#305;k &#231;al&#305;&#351;ma kitab&#305; olmad&#305;&#287;&#305;ndan &#231;&#305;klacakt&#305;r": GoTo 117                                '>>|
16      End If                                                                                             '>>|
17  Else                                                                                                   '>>|
18      soru = ActiveWorkbook.Name & " kitab&#305;n&#305;n " & ActiveSheet.Name                                      '>>|
19      soru = soru & " sayfas&#305;na Dosyalar listelenecektir." & vbLf & "Devam Etmek istiyormusunuz?"        '>>|
20      If MsgBox(soru, vbYesNo) = vbYes Then                                                              '>>|
21          GoTo 101                                                                                       '>>|
22      Else                                                                                               '>>|
23          GoTo 117                                                                                       '>>|
24      End If                                                                                             '>>|
25  End If                                                                                                 '>>|
101    Dim klsrSec As Object                                                                               '>>|
102    Dim klsrMsUstu, dosya, yol As String                                                                '>>|
103    Set klsrSec = CreateObject("Shell.Application").BrowseForFolder(0, "L&#252;tfen bir klasor se&#231;in !", 1)  '>>|
104    klsrMsUstu = CreateObject("WScript.Shell").SpecialFolders("Desktop")                                '>>|
105        If klsrSec Is Nothing Then GoTo 117                                                             '>>|
106        If klsrSec = "Masa&#252;st&#252;" Or klasor = "Desktop" Then                                              '>>|
107            yol = klsrMsUstu                                                                            '>>|
108            AnaListe (yol)                                                                              '>>|
109            AltListe (yol)                                                                              '>>|
110        ElseIf klsrSec <> "Masa&#252;st&#252;" Then                                                               '>>|
111            yol = klsrSec.Items.Item.Path                                                               '>>|
112            AnaListe (yol)                                                                              '>>|
113            AltListe (yol)                                                                              '>>|
114        Else                                                                                            '>>|
115            GoTo 117                                                                                    '>>|
116        End If                                                                                          '>>|
117    Set klsrSec = Nothing: ui = 0                                                                       '>>|
End Sub                                                                                                    '>>|
Private Sub AnaListe(yol As String)                                                                        '>>|
201 Dim dosya As String                                                                                    '>>|
202 Cells.ClearContents                                                                                    '>>|
203 Range("A1") = "Dosya Yolu":             Range("B1") = "Dosya Ad&#305;"                                      '>>|
204 Range("C1") = "Dosya Tipi":             Range("D1") = "Dosya Boyutu"                                   '>>|
205 Range("E1") = "Olu&#351;turulma Tarihi":     Range("F1") = "Son Eri&#351;im Tarihi"                              '>>|
206 Range("G1") = "Son D&#252;zenleme Tarihi":   Range("H1") = "Son D&#252;zenleme Zaman&#305;"                           '>>|
207 dosya = Dir(yol & "\*.*")                                                                              '>>|
208 ui = 1                                                                                                 '>>|
209 While dosya <> ""                                                                                      '>>|
210     DoEvents                                                                                           '>>|
211     ui = ui + 1                                                                                        '>>|
212     Cells(ui, 1) = yol                                                                                 '>>|
213     Cells(ui, 2) = dosya                                                                               '>>|
214     Call DosyaOzellikleri(yol & Application.PathSeparator & dosya)                                     '>>|
215     dosya = Dir                                                                                        '>>|
216 Wend                                                                                                   '>>|
End Sub                                                                                                    '>>|
Private Sub AltListe(yol As String)                                                                        '>>|
On Error Resume Next                                                                                       '>>|
301 Dim klsrAra, klsrLst As Object, dosya, dsyTYl As String                                                '>>|
302 Set klsrLst = CreateObject("Scripting.FileSystemObject").GetFolder(yol).SubFolders                     '>>|
303 On Error GoTo 316                                                                                      '>>|
304 For Each klsrAra In klsrLst                                                                            '>>|
305     dosya = Dir(klsrAra.Path & "\*.*")                                                                 '>>|
306     While dosya <> ""                                                                                  '>>|
307        DoEvents                                                                                        '>>|
308        ui = [a65000].End(3).Row + 1                                                                    '>>|
309        Cells(ui, 1) = klsrAra.Path & "\"                                                               '>>|
310        Cells(ui, 2) = dosya                                                                            '>>|
311        Call DosyaOzellikleri(klsrAra.Path & Application.PathSeparator & dosya)                         '>>|
312        dosya = Dir                                                                                     '>>|
313     Wend                                                                                               '>>|
314     AltListe (klsrAra.Path)                                                                            '>>|
315 Next                                                                                                   '>>|
316 Set klsrAra = Nothing: Set klsrLst = Nothing                                                           '>>|
End Sub                                                                                                    '>>|
Private Sub DosyaOzellikleri(dsyBak As String)                                                             '>>|
401 Dim DsSisKnt, Dosyam As Object                                                                         '>>|
402 Set DsSisKnt = CreateObject("Scripting.FileSystemObject")                                              '>>|
403 Set Dosyam = DsSisKnt.GetFile(dsyBak)                                                                  '>>|
404 With Dosyam                                                                                            '>>|
405    ActiveSheet.Hyperlinks.Add Anchor:=Range("B" & ui), address:=dsyBak                                 '>>|
406    Range("C" & ui) = .Type                                                                             '>>|
407    Range("D" & ui) = Format(.Size / 1024, "#,##0.0000") & " Kb"                                        '>>|
408    Range("E" & ui) = Format(.DateCreated, "dd.mm.yyyy")                                                '>>|
409    Range("F" & ui) = Format(.DateLastAccessed, "dd.mm.yyyy")                                           '>>|
410    Range("G" & ui) = Format(.DateLastModified, "dd.mm.yyyy")                                           '>>|
411    Range("H" & ui) = Format(.DateLastModified, "hh:mm:ss")                                             '>>|
412 End With                                                                                               '>>|
413 Set DsSisKnt = Nothing                                                                                 '>>|
414 Set Dosyam = Nothing                                                                                   '>>|
End Sub                                                                                                    '>>|
'Fel&#226;ket ba&#351;a gelmeden evvel, onu &#246;nleyecek ve ona kar&#351;&#305; savunulacak gerekleri d&#252;&#351;&#252;nmek l&#226;z&#305;md&#305;r.          '>>|
'Geldikten sonra d&#246;v&#252;nmenin faydas&#305; yoktur.ATAT&#220;RK                                                         '>>|
'<<=H=>> <<=S=>> <<=A=>> <<=Y=>> <<=A=>> <<=R=>> <<=&#8482;=>> <<==>> <<=www=>> . <<=excel=>> . <<=web=>> . <<=tr=>>|
'&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;&#168;'
 
Son düzenleme:
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
23 nolu mesajı yeniden düzenledim....
 
Son düzenleme:
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Sn hocalar&#305;m a&#351;a&#287;&#305;daki resimler bir katologlama program&#305;ndan al&#305;nt&#305;d&#305;r.



Bu resme g&#246;re bizde I-J-K-L s&#252;tunlar&#305;na RootPath-SerialNumber-DiskType - NAME de&#287;erlerini eklemek m&#252;mk&#252;nm&#252;d&#252;r.
 
Son düzenleme:
E

exart

Katılım
20 Mart 2009
Mesajlar
6
Excel Vers. ve Dili
Excel 2002 Türkçe
Merhaba,

Paylaşım için teşekkürler. Yukarıdaki verilen kodları çalıştıramadım. Bunun için özellikle gereken bir excel versiyonu, güncellemesi ya da eklentisi gerekli mi? Belkide kodlarımı yanlış yere yazdım.

Ben de klasör içindeki klasör ya da dosya adlarını A sütununa aktarmak istiyorum fakat beceremedim. Bunu biraz daha adım adım anlatabilir misiniz?

Teşekkürler,
 
K

kubile

Katılım
6 Aralık 2005
Mesajlar
37
Excel Vers. ve Dili
Ms.Excel 2007 TR
Ms.Excel 2007 EN
Sn. hsayar,

23. mesajda yeralan uygulamayı beğeniyle kullanıyor ve iş arkadaşlarımla paylaşıyorum.
Benim bu çalışmaya ek olabilecek bir ihtiyacım var.

İlk sütundaki adres hücrelerini her alt klasör için ayrı sütun açacak veya en az 3-4 sütun alta kadar inebilecek bir eklenti çalışmanıza dahil edilebilirmi ?

Daha önceden bu ihtiyacımı karşılayan bir koda rastlamıştım, kendi arşivimde henüz bulamadım.
Bulur bulmaz bende iletmeye çalışırım.

Saygılarımla,
 
M

mrt

Katılım
11 Mayıs 2005
Mesajlar
167
Excel Vers. ve Dili
office 2003 tr & eng.
office 2007 tr & eng.
Zeki Gürsoy' Alıntı:
Alternatif. Office 2007 de FileSearch sorunu yaşayanlar için kullanışlıdır.
Kod: 
Sub Start()
Dim klasor As Object
 
Set klasor = CreateObject("Shell.Application").BrowseForFolder _
                    (0, "Lütfen bir klasor seçin !", 1)
                    
Liste (klasor.Items.Item.Path)
AltListe (klasor.Items.Item.Path)
 
Set klasor = Nothing
End Sub
 
Private Sub Liste(yol As String)
Dim dosya As String, i As Long
 
    dosya = Dir(yol & "\*.*")
    i = 1
    While dosya <> ""
        DoEvents
        i = i + 1
        Cells(i, 1) = yol & dosya
        dosya = Dir
    Wend
End Sub
 
Private Sub AltListe(yol As String)
Dim fL As Object, f As Object, dosya As String, j As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(yol).SubFolders
 
On Error GoTo sonraki
For Each f In fL
    dosya = Dir(f.Path & "\*.*")
    
    While dosya <> ""
        DoEvents
        j = [a65000].End(3).Row + 1
        Cells(j, 1) = yol & "\" & dosya
        dosya = Dir
    Wend
    
    AltListe (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub
Genişletmek için tıkla ...

Selamlar,

Yukarıdaki kodları kullanarak, tarama yapılan dosyaların isimlerini listelemek istiyorum.

Dosya isimlerini, c:\MüşteriAdı, Yıl, Ay, Gün (c:\xx\2010\mart\01\taranan doya adı.dosya formatı) olarak oluşturmaktayız.

Kodları çalıştırdığımda, Ay ibaresinden sonra taranan dosya adları listeleniyor.

Günler listelenmiyor.

Nasıl düzeltebilirim.

Listelenen Listelenmesi gereken
F:\...\2010\mart\149-92661.pdf F:\...\2010\mart\01\149-92661.pdf
F:\...\2010\mart\161-2780.pdf F:\...\2010\mart\01\161-2780.pdf
F:\...\2010\mart\381-18686.pdf F:\...\2010\mart\02\381-18686.pdf
F:\...\2010\mart\149-92733.pdf F:\...\2010\mart\02\149-92733.pdf
F:\...\2010\mart\149-92742.pdf F:\...\2010\mart\02\149-92742.pdf
F:\...\2010\mart\149-92746.pdf F:\...\2010\mart\03\149-92746.pdf
F:\...\2010\mart\149-92749.pdf F:\...\2010\mart\03\149-92749.pdf
F:\...\2010\mart\149-92769.pdf F:\...\2010\mart\03\149-92769.pdf
 
H

hellfire39

Katılım
24 Haziran 2010
Mesajlar
1
Excel Vers. ve Dili
2007 TR
hsayar hocam süper yapmışsın, aynen çalıştı program bende. şöyle bir isteğim olacak: "bu macro' yu bir EXE olarak ayarlayabilir miyiz? EXE ye çift tıklayınca program açılsın klasörü seçelim ve otomatik bir excel dosyası açılarak içerisine gerekli veriler doldurulsun"

var mıdır mümkünatı? teşekkürler...
 
E

erkannyilmaz

Katılım
17 Şubat 2007
Mesajlar
6
Excel Vers. ve Dili
2003
program çok iyi olmuş, uzun zamandır böyle bir şey arıyordum, paylaşım için teşekkürler,
 
E

erkannyilmaz

Katılım
17 Şubat 2007
Mesajlar
6
Excel Vers. ve Dili
2003
denedimm program çok iyi çalışıyor, sizden bir ricam olacak, elimde gps li bir fotoğraf makinasından alınan fotoğraflar var ve fotoğrafların özelliklerin x ve y gibi koordinatlar var, program bu özellikleri almamış, bunları nasıl ekletebiliriz,
program böylede çok iyi, teşekkür ederim
 
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
erkannyilmaz' Alıntı:
denedimm program çok iyi çalışıyor, sizden bir ricam olacak, elimde gps li bir fotoğraf makinasından alınan fotoğraflar var ve fotoğrafların özelliklerin x ve y gibi koordinatlar var, program bu özellikleri almamış, bunları nasıl ekletebiliriz,
program böylede çok iyi, teşekkür ederim
Genişletmek için tıkla ...
bu özelliği içeren bir fotoğraf ekleyin belki kurcalayarak bulurum... ancak şimdiden olur yada olmaz diyemem.
EXE olarak çalıştırma konusunda bilgim olmadığı yönündedir. var ise de ben bilmiyorum. Bu arada bende sizler gibi bir meraklıyım. Maalesef kendimi hoca olarak göremiyorum.
 
E

esavas

Katılım
17 Ağustos 2004
Mesajlar
20
Excel Vers. ve Dili
Office 2003 Pro Tr, VBA, Access,
Teşekkürler

Değerli Excel dostları ve üstadları, klasör içeriğini görüntülemek için yazmış olduğunuz kodu kullandım ve bazı değişiklikler yaparak kullanımını kendime göre değiştirdim. Cells(1,1) değeri olarak klasör yolunu, alttaki diğer hücrelere de sadece dosyanın adını yazdırdım.

Selamlar
 
Y

yunseldepo

Katılım
14 Eylül 2011
Mesajlar
8
Excel Vers. ve Dili
2003
hepinize cok teşşekkur ederım

sımdıye kadar kı butun uygulamalarını gonderılız cok ıse yaradı. bır ıstegım hepınızden butun kodları yazdım calısıyor fakat ben bır buton koyup tıkladıgımda ıslemın gerceklesmesını ıstıryrm . bırde daha denemedım autocad uzantılarını gosterebılırmı
 

Ekli dosyalar

halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,842
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Alternatif kod birazcık kısaltılmış hali


Kod: 
Public sat As Long
Sub dosyaListele()
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
Cells.ClearContents
Range("A1") = "Dosya Yolu"
Range("B1") = "Dosya Adı"
Range("C1") = "Dosya Tipi"
Range("D1") = "Dosya Boyutu"
Range("E1") = "Oluşturulma Tarihi"
Range("F1") = "Son Erişim Tarihi"
Range("G1") = "Son Düzenleme Tarihi"
Range("H1") = "Son Düzenleme Zamanı"
AltListe (Kaynak)
MsgBox "işlem tamam !", vbInformation, "DİKKAT"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set Obj = Nothing
Set Klasor = Nothing
Exit Sub
Hata: MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
End Sub
Private Sub AltListe(yol As String)
Dim klsrAra, klsrLst As Object, Dosya
Set klsrLst = CreateObject("Scripting.FileSystemObject").GetFolder(yol).SubFolders
Dosya = Dir(yol & "\*.*")
While Dosya <> ""
DoEvents
sat = [a65000].End(3).Row + 1
Cells(sat, 1) = yol
Cells(sat, 2) = Dosya
On Error Resume Next
With CreateObject("Scripting.FileSystemObject").GetFile(yol & "\" & Dosya)
ActiveSheet.Hyperlinks.Add Anchor:=Range("B" & sat), Address:=yol & "\" & Dosya
Range("C" & sat) = .Type
Range("D" & sat) = Format(.Size / 1024, "#,##0.0000") & " Kb"
Range("E" & sat) = Format(.DateCreated, "dd.mm.yyyy")
Range("F" & sat) = Format(.DateLastAccessed, "dd.mm.yyyy")
Range("G" & sat) = Format(.DateLastModified, "dd.mm.yyyy")
Range("H" & sat) = Format(.DateLastModified, "hh:mm:ss")
End With
Dosya = Dir
Wend
On Error GoTo sonraki
For Each klsrAra In klsrLst
Call AltListe(klsrAra.Path)
sonraki:
Next
End Sub
 
Y

yunseldepo

Katılım
14 Eylül 2011
Mesajlar
8
Excel Vers. ve Dili
2003
Sızler yardımcı olabılırsınız

--------------------------------------------------------------------------------
Şimdiden yardım olucak arkadaşlara çok teşşekür ederim.
Sizden isteğim bır sey var 3'un den bırı olabılır.

Aşağıda attığım excel sayfasın makroyu calıstırdıgımız Ctrl+y arşvden genellıkle ağ bağlantısından dosyaları akıp excele aktarması suan cok ıyı calısıyor

1- Bır buton koyup tıkladıgımda makronun gorevını yerıne getırmesını ıstıyorum . Ctrl + y ayarladım gerek olmadan.

2- Ben bir filtre uygulaması yapıyorum 2 satıra fakat makro calıstıgında fıltreyı kaldırıyor yanı A1 den .... baslıyor programın kodlarını uyguluyor Bu duzenlebılırse cok ıyı olur olmazsada C2 textbax kutusu olsun yada baska bırsey ben ıcıne harflerı gırdıgım c sutununu ona gore sıralasın bır nevı arama ıslemı yaptırcam. kutunun ıcın dekı harlerı barındırıan haflerı gostersın Aynen
FILTRE OTOMATIK FILTRE DEN OZEL SECIP ICERIR OZELIIGINI SECTIGIMI ZAMAN KI UYGULAMA GIBI
 

Ekli dosyalar

Son düzenleme:
Y

yilmazweb

Katılım
17 Temmuz 2009
Mesajlar
31
Excel Vers. ve Dili
Microsoft Office Excel 2003
Zeki Hocam.
Dosyaları listeleyeceğimiz klasör yolunu belli bir hücreden aldırmak istersek kodu nasıl düzenlememiz gerekir.
 
Y

yilmazweb

Katılım
17 Temmuz 2009
Mesajlar
31
Excel Vers. ve Dili
Microsoft Office Excel 2003
Listeleyeceğimiz dosyarın bulunduğu dizini belli bir hücreden aldırmak istersek kodu nasıl düzenlememiz gerekir.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst