mehrere Dateien einlesen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub dateiauflisten() Dim i As Long With Application.FileSearch .NewSearch .LookIn = "D:\Bilder\Amerika" 'Suchverzeichnis .SearchSubFolders = False 'True = mit Unterverzeichnis .Filename = "*.jpg" 'Datei Typ .Execute For i = 1 To .FoundFiles.Count Debug.Print .FoundFiles(i) 'kompletter Pfad Debug.Print Right(.FoundFiles(i), Len(.FoundFiles(i)) - InStrRev(.FoundFiles(i), "\")) 'nur _ Name der Datei Next i End With End Sub

Hallo Leo,
eine Möglichkeit.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit
'by J.Ehrensberger
Private Function FileSearchFSO(ByRef Files As Variant, ByVal InitialPath As String, Optional ByVal FileName As String = "*", _
    Optional ByVal SubFolders As Boolean = False) As Long

Dim mobjFSO As Object, mfsoFolder As Object, mfsoSubFolder As Object, mfsoFile As Object

Set mobjFSO = CreateObject("Scripting.FileSystemObject")

Set mfsoFolder = mobjFSO.GetFolder(InitialPath)

On Error Resume Next

For Each mfsoFile In mfsoFolder.Files
    If Not mfsoFile Is Nothing Then
        If LCase(mobjFSO.GetFileName(mfsoFile)) Like LCase(FileName) Then
            If IsArray(Files) Then
                Redim Preserve Files(UBound(Files) + 1)
            Else
                Redim Files(0)
            End If
            Files(UBound(Files)) = mfsoFile
        End If
    End If
Next

If SubFolders Then
    For Each mfsoSubFolder In mfsoFolder.SubFolders
        FileSearchFSO Files, mfsoSubFolder, FileName, SubFolders
    Next
End If

If IsArray(Files) Then FileSearchFSO = UBound(Files) + 1
On Error GoTo 0
Set mobjFSO = Nothing
Set mfsoFolder = Nothing
End Function

Private Function fncBrowseForFolder(Optional ByVal defaultPath = "") As String
Dim objFlderItem As Object, objShell As Object, objFlder As Object

Set objShell = CreateObject("Shell.Application")
Set objFlder = objShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, defaultPath)

If objFlder Is Nothing Then GoTo ErrExit

Set objFlderItem = objFlder.Self
fncBrowseForFolder = objFlderItem.Path

ErrExit:

Set objShell = Nothing
Set objFlder = Nothing
Set objFlderItem = Nothing
End Function

Sub test()
Dim a
Dim result As Long, l As Long, strFolder As String, strExt As String

strFolder = fncBrowseForFolder

If strFolder = "" Then Exit Sub

strExt = "xls" 'gesuchte Dateiendung

result = FileSearchFSO(a, strFolder & "\", "*." & strExt, True)

If result <> 0 Then
    For l = 0 To UBound(a)
        'hier der Code zum Öffnen/Auslesen der Dateien
    Next
End If

End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

184 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

mehrere Dateien einlesen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

184 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread