ragnorak
Altın Üye
- Katılım
- 4 Haziran 2016
- Mesajlar
- 203
- Excel Vers. ve Dili
- Excel 2021
- Altın Üyelik Bitiş Tarihi
- 03-09-2026
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
On Error Resume Next
Dim evn As Object
cc = AYARLAR.TextBox20x.Text
Set evn = CreateObject("scripting.filesystemobject")
Set klasor = evn.GetFolder(cc)
For Each dosyalar In klasor.Files
a = Split(Replace(dosyalar.Name, ".accdb", ""), " ")
For i = 0 To UCase(a)
ListBox1.AddItem a(i)
ListBox1.List(ListBox1.ListCount - 1, 1) = a(i + 1)
ListBox1.List(ListBox1.ListCount - 1, 2) = a(i + 2)
Next
Next
ListBox1.ListIndex = 0
Private Sub CommandButton1_Click()
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
ListBox1.Clear
Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
For Each Dosya In fL.GetFolder(Kaynak).Files
uzanti = LCase(fL.GetExtensionName(Dosya))
If uzanti = "accdb" Then
ListBox1.AddItem
sat1 = ListBox1.ListCount - 1
ListBox1.List(sat1, 0) = Dosya.Name
ListBox1.List(sat1, 1) = Dosya
End If
Next
Else
atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Dim evn As Object
cc = AYARLAR.TextBox20x.Text
Set evn = CreateObject("scripting.filesystemobject")
Set klasor = evn.GetFolder(cc)
For Each dosyalar In klasor.Files
a = Split(Replace(dosyalar.Name, ".accdb", ""), " ")
With ListBox1
.AddItem a(i)
.List(.ListCount - 1, 1) = Format(a(i + 1), "dd.mm.yyyy")
.List(.ListCount - 1, 2) = a(i + 2)
.ListIndex = 0
End With
Next