Supportnet / Forum / Tabellenkalkulation

Hallo zusammen! ich habe eine frage bezüglich FSO in excel vba. Sub Filesearch() Dim strDir As String Dim objFSO As Object Dim objDir As Object Set objFSO = CreateObject("scripting.filesystemobject") strDir = "c:\ordner" Set objDir = objFSO.GetFolder(strDir) getInfo objDir, "*.pdf" Set objDir = Nothing Set objFSO = Nothing End Sub Sub getInfo(ByVal pCurrentDir As Object, ByVal strName As String) Dim aItem As Variant For Each aItem In pCurrentDir.Files If aItem.Name Like strName Then Debug.Print aItem.Path, aItem.Name End If Next For Each aItem In pCurrentDir.SubFolders getInfo aItem, strName Next End Sub wie muss ich das umschreiben, dass er mir in einer spalte untereinander alle dateinamen auflistet? viele grüße Philipp

hi all :-)

ein beispiel :-)

gruss nighty

Option Explicit
Sub FilesListen()
Dim Dateien As Integer
Dim zeile As Long
With Application.FileSearch
.NewSearch
.LookIn = "D:\Temp\"
.Filename = "*.xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
zeile = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
ThisWorkbook.Worksheets(1).Cells(zeile, 1) = Dir(.FoundFiles(Dateien))
Next Dateien
End If
End With
End Sub

Hi nighty

vielen dank für die Möglichkeit. Leider ist FileSearch hier im Unternehmen nicht ausführbar. deshalb muss ich leider über dieses file system object gehen.

gruß

Philipp

hi philipp :-)

dann halt so :-))

gruss nighty

Sub Filesearch()
Dim strDir As String
Dim objFSO As Object
Dim objDir As Object
Set objFSO = CreateObject("scripting.filesystemobject")
strDir = "D:\temp"
Set objDir = objFSO.GetFolder(strDir)
getInfo objDir, "*.xls"
Set objDir = Nothing
Set objFSO = Nothing
End Sub
Sub getInfo(ByVal pCurrentDir As Object, ByVal strName As String)
Dim aItem As Variant
For Each aItem In pCurrentDir.Files
If aItem.Name Like strName Then
zeile = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
ThisWorkbook.Worksheets(1).Cells(zeile, 1) = aItem.Name
End If
Next
End Sub

hi philipp :-)

wobei die nothing anweisung nur innerhalb einer excel instanz notwendig ist,sollte diese geschlossen werden wird der speicher ja wieder freigegeben :-))

gruss nighty

hi nighty,


vielen Dank für die hilfe! tut (fast) so wie ich will....
einziges problem sind jetzt noch subfolder. ich weiss bei filesearch gibts ja die möglichkeit auch subfolder zu durchsuchen. geht das auch hier?

vielen dank nochmal

gruß

Philipp

hi philipp :-)

muss mich da auch erst einarbeiten :-))

auf die schnelle

1 verzeichnistiefe

vielleicht reicht es ja so schon :-))

gruss nighty

Option Explicit
Dim FSO, FO, FU, F
Dim lRow As Long
Dim icol As Integer
Public Sub Files_Auflisten_Mit_Einer_Verzeichnistiefe_Von_1_Unterordner()
Dim strDir As String
Dim objFSO As Object
Dim objDir As Object
Call Filesearch
Set FSO = CreateObject("Scripting.FileSystemObject")
icol = 0
lRow = 0
Set FO = FSO.GetFolder("D:\Temp")
Set FU = FO.SubFolders
On Error Resume Next
For Each F In FU
lRow = lRow + 1
icol = icol + 1
Set objFSO = CreateObject("scripting.filesystemobject")
strDir = F.Name
Set objDir = objFSO.GetFolder(strDir)
getInfo objDir, "*.xls"
Set objDir = Nothing
Set objFSO = Nothing
Next
icol = icol - 1
End Sub
Sub Filesearch()
Dim strDir As String
Dim objFSO As Object
Dim objDir As Object
Set objFSO = CreateObject("scripting.filesystemobject")
strDir = "D:\temp"
Set objDir = objFSO.GetFolder(strDir)
getInfo objDir, "*.xls"
Set objDir = Nothing
Set objFSO = Nothing
End Sub
Sub getInfo(ByVal pCurrentDir As Object, ByVal strName As String)
Dim zeile As Long
Dim aItem As Variant
For Each aItem In pCurrentDir.Files
If aItem.Name Like strName Then
zeile = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
ThisWorkbook.Worksheets(1).Cells(zeile, 1) = aItem.Name
End If
Next
End Sub

passt! i like u =D

vielen dank

gruß

Philipp

zu spät .. aber jetz poste ich es trotzdem, dann wars nicht ganz so umsonst ;)

Sub main()
	Cells(1, 2) = 0
	files "c:\test"
	Cells(1, 2) = ""
End Sub
Sub files(dir)
	Set fso = CreateObject("scripting.filesystemobject")
	For Each f In fso.getfolder(dir).files
		Cells(1, 2) = Cells(1, 2) + 1
		Cells(Cells(1, 2), 1) = f
	Next
	For Each d In fso.getfolder(dir).subfolders
		files d
	Next
End Sub

hi möher :-)

fein fein :-))

so einfach und ich experimentiere hier mit ellenlangen codes grrr

erst mal kopiert :-)))

gruss nighty

hi möher :-)

und zu spaet schon gar nicht :-))

da der lerneffekt enorm ist :-)

gruss nighty

freut mich, dann wars ja doch nicht umsonst. :)
das rekursive verzeichnisauslesen ist immer ein aha-erlebnis für die, die es noch nicht kennen. ich kann mich auch noch dran erinnern, wie ich gestaunt hab, als ich es damals bei semi (dem alltime-grossmeister der sn-programmierrubriken, war aber wahrscheinlich vor deiner zeit) das erste mal gesehen hab.