Yedek Klasörü

[k0081]

Merhaba arkadaşlar;

E:\YEDEK\ yolu içinde ;

YEDEK_MDB_20_08_2016
YEDEK_MDB_27_10_2016
YEDEK_MDB_10_11_2016
YEDEK_MDB_15_11_2016
.....

gibi klasörler var. oluşturulan bu klasörlerin; en sonuncusunu(Tarih bakımından en son oluşturulan bu örnekte : YEDEK_MDB_15_11_2016 dir.) command buton ile bir değişkene nasıl alabilirim?

Örnek;

sontarih=15.11.2016

yardımcı arkadaşa şimdiden teşekkürler..

 

[PLİNT]

Merhaba
Klasör adına göre; istediğiniz böyle görünüyor.

[SIZE="2"]Private Sub CommandButton1_Click()
Dim n As Double
Dim klas, f
Dim sontarih As String, m As String
n = 0
Set f = CreateObject("scripting.filesystemobject")
Set klas = f.GetFolder("E:\YEDEK\")
For Each a In klas.SubFolders
m = a.Name
If InStr(1, m, "YEDEK_MDB", vbTextCompare) > 0 Then
m = Replace(Split(Trim(m), "YEDEK_MDB_")(1), "_", ".")
If n < CDbl(CDate(m)) Then n = CDbl(CDate(m)): [COLOR="Blue"]sontarih [/COLOR]= m
End If
Next a

MsgBox sontarih

End Sub [/SIZE]

Oluşturma tarihine göre;

[SIZE="2"]Private Sub CommandButton2_Click()
Dim n As Double
Dim klas, f
Dim sontarih As String
n = 0
Set f = CreateObject("scripting.filesystemobject")
Set klas = f.GetFolder("E:\YEDEK\")
For Each a In klas.SubFolders
m = a.Name
If InStr(1, m, "YEDEK_MDB", vbTextCompare) > 0 Then
m = Replace(Split(Trim(m), "YEDEK_MDB_")(1), "_", ".")
If n < CDbl(a.DateCreated) Then n = CDbl(a.DateCreated): [COLOR="Blue"]sontarih[/COLOR] = m
End If
Next a
MsgBox sontarih
End Sub
 [/SIZE]

 

[mancubus]

Sub xlTR_t167704_klasör_isim()
    
    Dim sf As Object
    Dim i As Long
    Dim sf_liste, tarih, sontarih
    
    With CreateObject("Scripting.FileSystemObject")
        With .GetFolder("E:\YEDEK")
            ReDim sf_liste(1 To .SubFolders.Count)
            For Each sf In .SubFolders
                i = i + 1
                tarih = Split(Right(sf.Name, 10), "_")
                sf_liste(i) = CDbl(DateSerial(tarih(2), tarih(1), tarih(0)))
            Next sf
        End With
    End With
    
    sontarih = Format(Application.Max(sf_liste), "dd/mm/yyyy")
    
    MsgBox sontarih

End Sub

cevapsız görünce konu üzerinde çalıştım ama araya bir şeyler girince mesajı göndermekte geciktim.
bu arada cevap gelmiş.

emek boşa gitmesin, alternatif olarak bulunsun.

 

[k0081]

PLİNT - mancubus;

Arkadaşlar çok teşekkürler, tamamdır.. Elinize Yüreğinize sağlık..