[Yardım]  klasördeki son dosya ismini excele aktarma

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

klasördeki son dosya ismini excele aktarma

İleti#1)  satilmiscam » 20 May 2019 14:35

Merhaba.

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 aşağıdaki örnekteki gibi.

dosya isimleri; B021905997. xlsx / B021905998. xlsx / B021905999 xlsx / B0219051000. xlsx / B0219051001. xlsx / B0219051002. xlsx / B0219051003. xlsx diye gidiyor.

ben burada en son dosya ismi olan B0219051003. xlsx olan dosyayı getirmek istiyorum. ama o bana B021905999 xlsx dosyayı getiriyor. yardımlarınızı bekliyorum.

kullandığım makro dolu aşağıdadır.

Kod: Tümünü seç
Function GetLastFile(ByVal folder As String) As String
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False


Sheets("Firmalar").Select
Dim cmdOutput As String

folder = Range("h1")

'// Make sure folder has trailing "\"
If Right$(folder, 1) <> Application.PathSeparator Then
folder = folder & Application.PathSeparator
End If
'// Use command prompt to get a directory listing, sorted in Z-A order and read all the output into a string variable
cmdOutput = CreateObject("WScript.Shell").Exec("CMD /C DIR """ & folder & "*.*"" /A:-D /B /O:-N").StdOut.ReadAll

'// Get the first line from the output
GetLastFile = CStr(Split(cmdOutput, vbCrLf)(0))

Sheets("isemriNo").Select
Range("a1").Select
End Function


Sub Dosyalarson()
Sheets("isemriNo").Select
Range("a1").Select
'MsgBox "Last file in folder is: " & GetLastFile("C:\Deneme\")

dosya = GetLastFile("folder")
Range("a1") = dosya

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True



End Sub
Kullanıcı avatarı
satilmiscam
 
Kayıt: 20 May 2019 12:32
Meslek: ziraat mühendisi
Yaş: 43
İleti: 4
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: klasördeki son dosya ismini excele aktarma

İleti#2)  serhatyrdmc » 20 May 2019 15:01

Kod: Tümünü seç
Sub dosyaismi()
Dim evn As Object
Set evn = CreateObject("scripting.filesystemobject")
folder = Range("h1")
Set klasor = evn.getfolder(folder)
For Each dosyalar In klasor.Files
If VBA.Right(dosyalar.Name, 4) = "xlsx" Then
Range("a1") = Replace(dosyalar.Name, ".xlsx", "")
End If
Next
End Sub
Kullanıcı avatarı
serhatyrdmc
Yeni Başlamış
 
Adı Soyadı:Serhat Yardımcı
Kayıt: 28 Mar 2011 21:07
İleti: 13
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara

Cevap: Cevap: klasördeki son dosya ismini excele aktarma

İleti#3)  satilmiscam » 22 May 2019 09:42

serhatyrdmc yazdı:
Kod: Tümünü seç
Sub dosyaismi()
Dim evn As Object
Set evn = CreateObject("scripting.filesystemobject")
folder = Range("h1")
Set klasor = evn.getfolder(folder)
For Each dosyalar In klasor.Files
If VBA.Right(dosyalar.Name, 4) = "xlsx" Then
Range("a1") = Replace(dosyalar.Name, ".xlsx", "")
End If
Next
End Sub


merhaba,
kod klasördeki son dosyayı getirmiyor.

örneğin B021905999.xlsb var sıra ile gidiyor ve en son dosya ise B0219051020.xlsb .
kodu çalıştırdığımızda B021905999.xlsb geliyor. ben son dosya olan B0219051020.xlsb nin gelmesini istiyorum.
ayrıca klasör içerisinde çok fazla dosya var ise kod çok yavaş çalışıyor. kod hızlandırılamaz mı?

internetten başka kod buldum. aşağıda size vereceğim. bu kod hızlı çalışıyor.
ama benim dosya isilerimde bazı dosya isimleri "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 getirilemez mi?

bulduğum kod

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

yardımlarınız için çok teşekkürler.
Kullanıcı avatarı
satilmiscam
 
Kayıt: 20 May 2019 12:32
Meslek: ziraat mühendisi
Yaş: 43
İleti: 4
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: klasördeki son dosya ismini excele aktarma

İleti#4)  Tarkan VURAL » 22 May 2019 10:02

Merhaba,
Son dosya ne demektir? İçerisindeki sayının en büyük olması durumunda olan dosya, son dosya mıdır ? En son oluşturma tarihine sahip dosya mıdır ? "En son" tasviri neyi ifade ediyor ?
Resim
www.tarkanvural.com.tr

İnnâ lillâhi ve innâ ileyhi raciûn
Şüphesiz ki; biz Allah’a âidiz ve vakti geldiğinde O’na döndürüleceğiz.

HasbunAllâhu ve nimel vekîl
Bize Allah yeter. O ne güzel vekildir.


ExcelVBA.NET' e katkıda bulunmak ister misiniz ? O halde BAĞIŞ butonunu tıklayın...
Kullanıcı avatarı
Tarkan VURAL
Yönetim Kurulu
 
Adı Soyadı:Tarkan VURAL
Kayıt: 14 Haz 2008 18:27
Konum: @tarkanvural73
Meslek: LUU, Database Expert, Senior Software Specialist, Developer
Yaş: 45
İleti: 26991
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul - Beylikdüzü

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Cevap: klasördeki son dosya ismini excele aktarma

İleti#5)  satilmiscam » 22 May 2019 10:27

Tarkan VURAL yazdı:Merhaba,
Son dosya ne demektir? İçerisindeki sayının en büyük olması durumunda olan dosya, son dosya mıdır ? En son oluşturma tarihine sahip dosya mıdır ? "En son" tasviri neyi ifade ediyor ?


Merhaba ,

Son dosyadan anlatmak istediğim şudur.

benim her müşteriye ait klasörlerim var. her klasör firma isminin baş harfi ile kodlu yani firma BEST ise Kodu B ile başlıyor.
b ile başlayan her firmanın kendi içinde sırası var. yani BEST firması B ile başlayan ikinci firma ise kodu B02 oluyor. eğer 11. firma ise B11 oluyor.
excel sayfamı farklı kaydederken bu kodun yanına şimdiki yıl "19", şimdiki ay "05" ve en son dosya sırası 1020 gibi isim veriyorum ve
dosya ismim B02 19 05 1020 yani B0219051020.xlsb oluyor. bazen de dosya ismini B0219051021 termal.xlsb, yada
B0219051022-kraft.xlsb, yada sadece B0219051023.xlsb olarak kullanıyorum. firmaya yeni isim vereceğim zaman en son hangi isimde kaldığını aramadan makro ile son dosya ismini getirmek istiyorum.
bu durumda makro bana son dosya ismi olan B0219051023.xlsb yi getirecek ve ben 1 ekleyip B0219051024.xlsb olarak kaydedeceğim.

excel dosyası içerisinde firma kodu, ay, yıl, seri nosunu parçalayıp birleştiriyorum. ay ve yıldeğişince bunlar değişiyor.

ben sadece en son serideki dosya ismini excele hızlı bir şekilde getirmek istiyorum. dosya ismindeki boşluk " " ve tire "-" işaretlerine takılarak isim uzunluğundan son dosya olarak algılamasın. isim uzunluğu, kaydedilme tarihi önemli değil. önemli olan serideki son dosya olması önemlidir.
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 serideki dosya getirilemez mi?

bulduğum kod

Kod: Tümünü seç
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


yardımlarınız için çok teşekkürler.
Kullanıcı avatarı
satilmiscam
 
Kayıt: 20 May 2019 12:32
Meslek: ziraat mühendisi
Yaş: 43
İleti: 4
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: klasördeki son dosya ismini excele aktarma

İleti#6)  Tarkan VURAL » 22 May 2019 11:21

Anladım.
Şu şekilde deneyiniz :

Kod: Tümünü seç
Function evnSonDosyaIsmi(ByVal Klasor As String, ByVal firmakodu As String, ByVal yil As Integer, ByVal ay As Integer) As String
Dim fso As Object, sondosya As Long
sondosya = 0
Set fso = CreateObject("scripting.filesystemobject")
If ay < 10 Then ayno = "0" & ay
If fso.folderexists(Klasor) Then
    For Each dosya In fso.getfolder(Klasor).Files
        aranan = firmakodu & yil & ayno
        If dosya.Name Like firmakodu & yil & ayno & "*" Then
            If Mid(dosya.Name, 8, 4) > sondosya Then sondosya = Mid(dosya.Name, 8, 4)
        End If
    Next
    evnSonDosyaIsmi = sondosya + 1
Else
    MsgBox Klasor & " klasörü bulunamadı.", vbCritical, "Www.ExcelVBa.Net"
End If
End Function


Sub YeniDosyaIsmiVer()
Dim yol As String, firmakodu As String, yil As Integer, ay As Integer, ayno As String
yol = "C:\Users\tarkan.vural\Desktop\DOSYALAR"
firmakodu = "B02"
yil = 19
ay = 5
If ay < 10 Then ayno = "0" & ay
dosyam = evnSonDosyaIsmi(yol, firmakodu, yil, ay)
MsgBox firmakodu & yil & ayno & dosyam
End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Resim
www.tarkanvural.com.tr

İnnâ lillâhi ve innâ ileyhi raciûn
Şüphesiz ki; biz Allah’a âidiz ve vakti geldiğinde O’na döndürüleceğiz.

HasbunAllâhu ve nimel vekîl
Bize Allah yeter. O ne güzel vekildir.


ExcelVBA.NET' e katkıda bulunmak ister misiniz ? O halde BAĞIŞ butonunu tıklayın...
Kullanıcı avatarı
Tarkan VURAL
Yönetim Kurulu
 
Adı Soyadı:Tarkan VURAL
Kayıt: 14 Haz 2008 18:27
Konum: @tarkanvural73
Meslek: LUU, Database Expert, Senior Software Specialist, Developer
Yaş: 45
İleti: 26991
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul - Beylikdüzü

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Cevap: klasördeki son dosya ismini excele aktarma

İleti#7)  satilmiscam » 23 May 2019 11:04

Tarkan VURAL yazdı:Anladım.
Şu şekilde deneyiniz :

Kod: Tümünü seç
Function evnSonDosyaIsmi(ByVal Klasor As String, ByVal firmakodu As String, ByVal yil As Integer, ByVal ay As Integer) As String
Dim fso As Object, sondosya As Long
sondosya = 0
Set fso = CreateObject("scripting.filesystemobject")
If ay < 10 Then ayno = "0" & ay
If fso.folderexists(Klasor) Then
    For Each dosya In fso.getfolder(Klasor).Files
        aranan = firmakodu & yil & ayno
        If dosya.Name Like firmakodu & yil & ayno & "*" Then
            If Mid(dosya.Name, 8, 4) > sondosya Then sondosya = Mid(dosya.Name, 8, 4)
        End If




    Next
    evnSonDosyaIsmi = sondosya + 1
Else
    MsgBox Klasor & " klasörü bulunamadı.", vbCritical, "Www.ExcelVBa.Net"
End If
End Function


Sub YeniDosyaIsmiVer()
Dim yol As String, firmakodu As String, yil As Integer, ay As Integer, ayno As String
yol = "C:\Users\tarkan.vural\Desktop\DOSYALAR"
firmakodu = "B02"
yil = 19
ay = 5
If ay < 10 Then ayno = "0" & ay
dosyam = evnSonDosyaIsmi(yol, firmakodu, yil, ay)
MsgBox firmakodu & yil & ayno & dosyam
End Sub




merhaba Tarkan Bey,

yukarıda verdiğiniz kodu denedim olmadı. firma değişince kod değişmiyor.

ama ben yeni bir kod buldum. bu kod her durumda en son dosya ismini getiriyor.

ama bulduğum kod klasörde çok fazla dosya var ise (örneğin 5000 adet) çok yavaş çalışıyor. siz vereceğim bu kodu her durumda hızlı çalışacak şekilde ayarlayabilir misiniz?

yardımlarınız için çok teşekkürler.

bulduğum kod.

Sub Son_Dosya_Adi()

Dim Klasor As String
Dim ds, dc, f, son

Klasor = Range("h1")

Set ds = CreateObject("Scripting.FileSystemObject")
'Set f = ds.GetFolder(ThisWorkbook.Path)
'Set f = ds.GetFolder("D:\B02-BEST A.?\")
Set f = ds.getfolder(Klasor)
Set dc = f.Files

son = 0
For Each dosya In dc
If IsNumeric(Mid(dosya.Name, 2, Len(dosya.Name) - 6)) Then
If Val(Mid(dosya.Name, 2, Len(dosya.Name) - 6)) > son Then _
son = Val(Mid(dosya.Name, 2, Len(dosya.Name) - 6))
End If
Next
'MsgBox son
Sheets(1).Range("a1") = son


End Sub
Kullanıcı avatarı
satilmiscam
 
Kayıt: 20 May 2019 12:32
Meslek: ziraat mühendisi
Yaş: 43
İleti: 4
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: klasördeki son dosya ismini excele aktarma

İleti#8)  Tarkan VURAL » 23 May 2019 11:09

satilmiscam yazdı:yukarıda verdiğiniz kodu denedim olmadı. firma değişince kod değişmiyor.

Anlamadım.

satilmiscam yazdı:ama ben yeni bir kod buldum. bu kod her durumda en son dosya ismini getiriyor.

Harika, kolay gelsin. --)(
Resim
www.tarkanvural.com.tr

İnnâ lillâhi ve innâ ileyhi raciûn
Şüphesiz ki; biz Allah’a âidiz ve vakti geldiğinde O’na döndürüleceğiz.

HasbunAllâhu ve nimel vekîl
Bize Allah yeter. O ne güzel vekildir.


ExcelVBA.NET' e katkıda bulunmak ister misiniz ? O halde BAĞIŞ butonunu tıklayın...
Kullanıcı avatarı
Tarkan VURAL
Yönetim Kurulu
 
Adı Soyadı:Tarkan VURAL
Kayıt: 14 Haz 2008 18:27
Konum: @tarkanvural73
Meslek: LUU, Database Expert, Senior Software Specialist, Developer
Yaş: 45
İleti: 26991
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul - Beylikdüzü


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot, Google [Bot] ve 2 misafir

Bumerang - Yazarkafe