AW: Bahnhof...
20.01.2017 09:44:26
Tom
Ich möchte gern mehrere Dateien aus einen Ordner einlesen aber nur bestimmte. In diesen Ordner sind ich 20-30 xls Dateien aber ich brauch nur 5-6 Dateien die in eine Arbeitsmappe zusammengeführt werden sollen und am besten jede eine eigenen Worksheet bekommt als die Datei Tab1.3.xls findet man dann im Worksheet2 und die nächste im Worksheet3. Das wäre am besten wenn ich nur den Pfad auswähle und er nimmt automatisch immer die Datei die ich brauche die haben auch immer den selben Namen.
ich hab auch schon Code gefunden aber ich weis nicht wie ich weiter komme hier ist der Code:
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