- 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.
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