hasanyaprak
Altın Üye
- Katılım
- 9 Aralık 2010
- Mesajlar
- 69
- Excel Vers. ve Dili
- İş office 2021 / Ev ofis 2016 64 bit
- Altın Üyelik Bitiş Tarihi
- 13-10-2025
Arkadaşlar selam,
Aşağıdaki kodda dosya ve dosyanın bulunduğu yolu alıyor. Dosyanın bulunduğu yol tek sutunda değilde klasör klasör ayrı yazılabilir mi?
Örnek: C:\Users\hasan\Desktop\PDM_CALISMA
A sutunu: C
B sutunu: Users
C sutunu: hasan
D sutunu: Desktop
E sutunu: PDM_CALISMA
Desteğinizi rica ederim.
VBA sız çözümde olabilir.
Set ds = CreateObject("Scripting.FileSystemObject")
Yol = Sheets("KOD_YAPISI").Range("A1")
'yol = ThisWorkbook.Path
'Columns(2).Clear
Sheets("KOD_YAPISI").Range("A4:C200000").ClearContents
Application.ScreenUpdating = False
Do
Tekrar:
If ds.GetFolder(Yol).subfolders.Count > 0 Then
For Each kls In ds.GetFolder(Yol).subfolders
klslst = klslst & "{" & kls
Next
End If
x = x + 1
deg = Split(klslst, "{")
Yol = deg(x)
Dosya = Dir$(Yol & "\*.*")
Do While Dosya <> ""
Say = Say + 1
Cells(Say + 3, 3) = Dosya
Cells(Say + 3, 1) = Yol & "\" & Dosya
Cells(Say + 3, 2) = Yol
Dosya = Dir$()
Loop
If x = 1 And ds.GetFolder(Yol).subfolders.Count > 0 Then GoTo Tekrar
Loop While UBound(deg) <> x
Aşağıdaki kodda dosya ve dosyanın bulunduğu yolu alıyor. Dosyanın bulunduğu yol tek sutunda değilde klasör klasör ayrı yazılabilir mi?
Örnek: C:\Users\hasan\Desktop\PDM_CALISMA
A sutunu: C
B sutunu: Users
C sutunu: hasan
D sutunu: Desktop
E sutunu: PDM_CALISMA
Desteğinizi rica ederim.
VBA sız çözümde olabilir.
Set ds = CreateObject("Scripting.FileSystemObject")
Yol = Sheets("KOD_YAPISI").Range("A1")
'yol = ThisWorkbook.Path
'Columns(2).Clear
Sheets("KOD_YAPISI").Range("A4:C200000").ClearContents
Application.ScreenUpdating = False
Do
Tekrar:
If ds.GetFolder(Yol).subfolders.Count > 0 Then
For Each kls In ds.GetFolder(Yol).subfolders
klslst = klslst & "{" & kls
Next
End If
x = x + 1
deg = Split(klslst, "{")
Yol = deg(x)
Dosya = Dir$(Yol & "\*.*")
Do While Dosya <> ""
Say = Say + 1
Cells(Say + 3, 3) = Dosya
Cells(Say + 3, 1) = Yol & "\" & Dosya
Cells(Say + 3, 2) = Yol
Dosya = Dir$()
Loop
If x = 1 And ds.GetFolder(Yol).subfolders.Count > 0 Then GoTo Tekrar
Loop While UBound(deg) <> x