Idézet: Löfi - Dátum: 2009. szept. 22., kedd - 21:16
Sziasztok,
Ingyenes szoftvert keresek, amely segítségével exportálhatjuk XLS vagy szöveges fájlba a mappáinkban található fájlok listáját egész könyvtárstruktúrával együtt.
Találkozott már valaki ilyen progival?
köszi
CMD
Akármelyik mappába belépel, ott kiadod:
DIR /S > %fileneve%.XLS
%fileneve%.XLS-t megnyitod...
Megdolgozod ezzel a makróval:
Sub Dir2Tabla()
'Emészthető Táblázattá alakítja a DIR /S parancs outputját
'By HKPK
Cells(1, 1).Select
rekordszám = ActiveCell.SpecialCells(xlLastCell).Row()
If Left(ActiveCell.Value(), 14) = " A meghajt˘ban" Then
Rows(ActiveCell.Row()).Delete
rekordszám = rekordszám - 1
End If
If Left(ActiveCell.Value(), 16) = " A k”tet sorozat" Then
Rows(ActiveCell.Row()).Delete
rekordszám = rekordszám - 1
End If
If IsEmpty(ActiveCell) Then
Rows(ActiveCell.Row()).Delete
rekordszám = rekordszám - 1
End If
Columns("A:D").Insert Shift:=xlToRight
For Each ciklus_cella In Range(Cells(1, 1), Cells(rekordszám, 1))
ciklus_cella.NumberFormat = "yyyy.mm.dd"
ciklus_cella.Value = Format((Left(ciklus_cella.Offset(0, 4).Value(), 10)))
ciklus_cella.Offset(0, 1).Value() = Format(Mid(ciklus_cella.Offset(0, 4).Value(), 14, 5))
ciklus_cella.Offset(0, 2).Value() = Format(Mid(ciklus_cella.Offset(0, 4).Value(), 19, 18))
Next
For i = 1 To rekordszám
If IsEmpty(Cells(i, 1)) Then
Rows(i).Delete
End If
If Left(Cells(i, 1), 2) = " " Then
Rows(i).Delete
End If
Next i
For i = 1 To rekordszám
If IsEmpty(Cells(i, 1)) Then
Rows(i).Delete
End If
If Left(Cells(i, 1), 2) = " " Then
Rows(i).Delete
End If
Next i
For i = 1 To rekordszám
If IsEmpty(Cells(i, 5)) Then Exit For
If Right(Cells(i, 5).Value, 9) = "tartalma:" Then
Mappa = LTrim(Left(Cells(i, 5).Value, Len(Cells(i, 5)) - 10))
Else
Cells(i, 4).Value = Mappa & "\" & Right(Cells(i, 5).Value, Len(Cells(i, 5)) - 37)
End If
Next i
Columns("C:C").Replace What:="˙", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("E:E").Delete Shift:=xlToLeft
Columns("A:D").EntireColumn.AutoFit
Range("A1").FormulaR1C1 = "Dátum"
Range("B1").FormulaR1C1 = "Idő"
Range("C1").FormulaR1C1 = "Méret"
Range("D1").FormulaR1C1 = "Fájl"
Range("A1:D1").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Selection.Font.Bold = True
Range("A2").Select
ActiveWindow.FreezePanes = True
For i = 1 To rekordszám
If IsEmpty(Cells(i, 4)) Then
Rows(i).Delete
End If
If IsEmpty(Cells(i, 1)) Then Exit For
Next i
End Sub
Szerk: XP DIR parancsához van írva a makró, jut szembe, régebbi windozok DIR-je más volt, lehet az újabbaké is más....
Szerkesztette: hkpk 2009. 09. 23. 15:34 -kor
Súgó
A téma zárva.
