Soru Getfolder yerine sabit bir dosya adresi kullanmak

Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
Altın Üyelik Bitiş Tarihi
10-06-2024
Merhaba
Yüzlerce excel dosyasını sıralamak için bir kod kullanıyorum.
Her seferinde bana dosyanın adresini sorması bu işlemi otomatik hale getirmemi engelliyor.

Kaynak değişkenini "S:\TRT\Y-90" haline getirdiğimde kodu bir türlü çalıştıramıyorum.

PHP:
Dim sayi
Dim sat
Sub klasör_dosya3()

Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Klasörü Seçin", 50, &H0)
If Klasor Is Nothing Then Exit Sub
Kaynak = Klasor.self.Path
'Kaynak = ThisWorkbook.Path & "\deneme"
Cells.ClearContents
Cells.Hyperlinks.Delete
Cells.Font.ColorIndex = 0

deg1 = Split(Kaynak, "\")
Cells(1, 1).Value = deg1(UBound(deg1))
sat = 1
If UBound(deg1) > 0 Then
sayi = UBound(deg1)
End If
Liste (Kaynak)
MsgBox "işlem tamam"
End Sub
Private Sub Liste(yol As String)
Dim fL As Object, fs As Object, f As Object, j As Long, n As Long
Set fL = CreateObject("Scripting.FileSystemObject")

deg1 = Split(yol, "\")
If UBound(deg1) > 0 Then
sut = UBound(deg1) + 1 - sayi
End If

'Cells(sat, sut) = fL.GetBaseName(yol) 'dosya.Name
Cells(sat, sut).Hyperlinks.Add Anchor:=Cells(sat, sut), Address:=yol, SubAddress:="" & firstAddress, TextToDisplay:=fL.GetBaseName(yol)
fL.GetBaseName (yol)

sut = sut + 1

If fL.GetFolder(yol).Files.Count > 0 Then
sat = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For Each dosya In fL.GetFolder(yol).Files
'Cells(sat, sut) = fL.GetBaseName(dosya.Name)  'dosya.Name
Cells(sat, sut).Hyperlinks.Add Anchor:=Cells(sat, sut), Address:=dosya, SubAddress:="" & firstAddress, TextToDisplay:=fL.GetBaseName(dosya.Name)
'sat = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
sut = sut + 1
Next
End If

On Error GoTo sonraki
For Each f In fL.GetFolder(yol).subfolders
Liste (f.Path)
sat = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
sonraki:
Next

End Sub
 

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,356
Excel Vers. ve Dili
Office 365 (64 bit) - Türkçe
Çalışmadığında runtime error dönüyor olmalı... İletide ne yazıyor?
 
Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
Altın Üyelik Bitiş Tarihi
10-06-2024
klasörü kendim seçtiğimde gayet güzel çalışıyor.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,311
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Kodu adım adım çalıştırın. Aşağıdaki satıra gelince mouse ile ilgili satirin üzerine gelin ve oluşan değeri dikkate alın.

Kaynak = Klasor.self.Path
 
Katılım
9 Aralık 2018
Mesajlar
363
Excel Vers. ve Dili
Excel 2019 - 32 bit TR
Altın Üyelik Bitiş Tarihi
10-06-2024
Listelenen dosyalar içerisinde sadece "XLSM" dosyalarını listele gibi bir seçimi yapmak mümkün mü?
 
Üst