home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 2005 July & August
/
PCWorld_2005-07-08_cd.bin
/
software
/
vyzkuste
/
tipy
/
tipy.exe
/
pcwseznam.bas
< prev
next >
Wrap
BASIC Source File
|
2005-05-11
|
3KB
|
97 lines
Attribute VB_Name = "Modul2"
Dim n
Dim dname(10000)
Dim dordner(10000)
Dim dcreated(10000)
Dim dpfad(10000)
Dim dlast(10000)
Dim dtyp(10000)
Dim dsize(10000)
Sub Seznam_souboru()
n = 0
Set MyShell = CreateObject("wscript.shell")
Set MyFiles = CreateObject("Scripting.FileSystemObject")
Set Appshell = CreateObject("Shell.Application")
On Error Resume Next
Set AppFolder = Appshell.BrowseForFolder(0, "", &H1, 17)
verz = AppFolder.ParentFolder.ParseName(AppFolder.Title).Path
If Err.Number > 0 Then
i = InStr(AppFolder, ":")
verz = Mid(AppFolder, i - 1, 1) & ":\"
End If
If verz = "" Then Exit Sub
StartFolder = verz
Set drive = MyFiles.GetFolder(verz)
Set dat = drive.Files
For Each datei In dat
n = n + 1
dname(n) = datei.Name
dordner(n) = drive.Path
dpfad(n) = datei.Path
dsize(n) = datei.Size
dcreated(n) = datei.datecreated
dlast(n) = datei.DateLastAccessed
dtyp(n) = datei.Type
Next
Search drive
Documents.Add DocumentType:=wdNewBlankDocument
Selection.WholeStory
Selection.ParagraphFormat.TabStops.ClearAll
Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(4), _
Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
Selection.TypeText "Slo₧ka " & StartFolder
Selection.TypeParagraph
Selection.TypeParagraph
For x = 1 To n
Selection.TypeText "JmΘno souboru:" & Chr(9) & dname(x)
Selection.TypeParagraph
Selection.TypeText "Slo₧ka:" & Chr(9) & dordner(x)
Selection.TypeParagraph
Selection.TypeText "Velikost:" & Chr(9) & dsize(x)
Selection.TypeParagraph
Selection.TypeText "Vytvo°en:" & Chr(9) & dcreated(x)
Selection.TypeParagraph
Selection.TypeText "Naposledy otev°en:" & Chr(9) & dlast(x)
Selection.TypeParagraph
Selection.TypeParagraph
Next
Selection.TypeParagraph
Selection.TypeText n & " soubor∙ ve slo₧ce " & StartFolder
Application.ScreenUpdating = True
m = MsgBox(n & " soubor∙ vypsßno." & Chr(13) & "Vytvo°it dalÜφ seznam soubor∙?", 4)
If m = 6 Then Seznam_souboru
End Sub
Sub Search(ByVal StartFolder)
Set Weitere = StartFolder.SubFolders
For Each AktuellerOrdner In Weitere
Set dat = AktuellerOrdner.Files
For Each datei In dat
n = n + 1
dname(n) = datei.Name
dordner(n) = AktuellerOrdner.Path
dpfad(n) = datei.Path
dsize(n) = datei.Size
dcreated(n) = datei.datecreated
dlast(n) = datei.DateLastAccessed
dtyp(n) = datei.Type
Next
Search AktuellerOrdner
Next
End Sub