satilmiscam
Yeni Üye
- Katılım
- 22 May 2019
- Mesajlar
- 2
- En iyi yanıt
- 0
- Puanları
- 1
- Yaş
- 48
- Konum
- İstanbul
- Ad Soyad
- Satılmış Çam
Ben excel sayfasına h1hücresindeki dosya yolunu dikkate alarak bu klasördeki en son dosya ismini a1 hücresine yazdırmak istiyorum. Dosya uzantısını almasa da olur.
İnternette formlarda çok araştırdım. Dosya isimlerini getiriyorum, ama sıralı getiremiyorum.
benim dosya isimlerim "B0219051004 denisson tel. xlsb " / "B0219051005-termal tel. xlsb " "B0219051006. xlsb" gibidir. burada makro çalışınca "B0219051006. xlsb" gelmesi gerekirken "B0219051004 denisson tel. xlsb " geliyor. burada sadece baştan boşluğa " " kadar veya tire "-" işaretine kadar olan bölüm alınamaz mı? yani sadece "B0219051006" şeklinde en son dosya getirilemez mi?
bulduğum kod
İnternette formlarda çok araştırdım. Dosya isimlerini getiriyorum, ama sıralı getiremiyorum.
benim dosya isimlerim "B0219051004 denisson tel. xlsb " / "B0219051005-termal tel. xlsb " "B0219051006. xlsb" gibidir. burada makro çalışınca "B0219051006. xlsb" gelmesi gerekirken "B0219051004 denisson tel. xlsb " geliyor. burada sadece baştan boşluğa " " kadar veya tire "-" işaretine kadar olan bölüm alınamaz mı? yani sadece "B0219051006" şeklinde en son dosya getirilemez mi?
bulduğum kod
PHP:
Sub XD_SonDosya()
Dim XD() As String
Dim i As String
Dim Klasor As String
Klasor = Range("h1")
'XD_Yol = ThisWorkbook.Path & "\TimeSheet\" 'KLASOR YOLUNU BEL?RT?N'"
XD_Yol = Klasor 'KLASOR YOLUNU BEL?RT?N'"
If Right(XD_Yol, 1) <> "\" Then XD_Yol = XD_Yol & "\" '"
'XD_Dosya = Dir(XD_Yol & "*.xlsx", vbNormal)
XD_Dosya = Dir(XD_Yol & "*.*", vbNormal)
If Len(XD_Dosya) = 0 Then
MsgBox "Belirtilen dizinde dosya bulunmamaktad?r...", vbExclamation, "XXxxXXxxXX"
Exit Sub
End If
i = 0
Do While "" <> XD_Dosya
i = i + 1
ReDim Preserve XD(1 To i)
XD(i) = Len(dosya)
If i <> 1 Then
If XD(i - 1) > XD(i) Then
Exit Do
End If
End If
XDdosya = dosya
dosya = Dir
Loop
'MsgBox XDdosya
Sheets(1).Range("a1") = XDdosya
End Sub
Moderatör tarafında düzenlendi: