Hallo Guste.
Ich habe ein Excel-Makro geschrieben, das Deine beschriebenen Funktionen erfüllt. Die ganze Geschichte unterscheidet sich aber dahingehend, dass die Reihenfolge von der in Deiner Beschreibung abweicht. Das heißt: Es muss zuerst die Excel-Datei geöffnet werden, dann werden die Dateien eingelesen. Momentan ist in dem Code eine Konstante deklariert, die den Pfad zum Stick enthält.
Bitte starte Excel und gehe dann (z.B. mit Alt+F11) in den VisualBasic-Editor.
Klicke im Menü "Einfügen" auf "Modul", danach siehst Du im Projekt-Explorer das hinzugefügte Modul, das standardmäßig den Namen "Modul1" erhalten haben sollte, und es öffnet sich dessen Code-Fenster.
'Öffentliche Kostanten
Public Const StickPath As String = "E:\"
Public Const DefaultExt As String = ".txt"
'******************************************************
'Öffentliche Methoden
Public Sub ReadTextFilesOnStick()
'Lokale Variablen
Dim FSO
Dim Folder
Dim Files
Dim File
Dim TextFileCount As Long
Dim TextFileList() As String
Dim LastRow As Long
'*****************************************************On Error GoTo ErrHandler
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(StickPath)
Set Files = Folder.Files
If Files.Count = 0 Then GoTo NoFilesFound
For Each File In Files
If Right(File.Name, 4) = DefaultExt Then
TextFileCount = TextFileCount + 1
ReDim Preserve TextFileList(0 To TextFileCount - 1)
TextFileList(UBound(TextFileList())) = File.Name
End If
Next
If TextFileCount = 0 Then GoTo NoFilesFound
msgtext = "Es wurden " & CStr(TextFileCount) & " Dateien gefunden:" & vbCr
For i = LBound(TextFileList()) To UBound(TextFileList())
msgtext = msgtext & vbCr & TextFileList(i)
Next
msgtext = msgtext & vbCr & vbCr & "Dateien einlesen?"
Answer = MsgBox(msgtext, vbYesNo + vbInformation)
If Answer = vbYes Then
LastRow = Tabelle1.Range("A" & Tabelle1.Rows.Count).Rows.End(xlUp).Row
If LastRow = 1 Then
If (IsEmpty(Tabelle1.Range("A1")) = False) Then LastRow = LastRow + 1
Else
LastRow = Tabelle1.Range("A" & Tabelle1.Rows.Count).Rows.End(xlUp).Row + 1
End If
For i = LBound(TextFileList()) To UBound(TextFileList())
Call ReadTextFileContent(TextFileList(i), LastRow)
LastRow = Tabelle1.Range("A" & Tabelle1.Rows.Count).Rows.End(xlUp).Row + 1
Next
End If
ExitSub:Erase TextFileList()
Exit Sub
NoFilesFound:MsgBox "Es wurden keine Text-Dateien gefunden.", vbOKOnly + vbInformation
GoTo ExitSub
ErrHandler:MsgBox Err.Description, vbOKOnly + vbCritical, "Fehler " & Err.Number
Resume ExitSub
End Sub
Public Sub ReadTextFileContent(ByVal FileName As String, ByVal Row As Long, Optional ByVal Delimeter As String = ",")
'Lokale Variablen
Dim TextFileLineCount As Long
Dim TextFileLineContent() As String
Dim RangeContent() As String
'*****************************************************
On Error GoTo ErrHandler
txtfile = FreeFile
Open StickPath & FileName For Input As #txtfile
Do While Not EOF(txtfile)
ReDim Preserve TextFileLineContent(0 To TextFileLineCount)
Line Input #txtfile, TextFileLineContent(TextFileLineCount)
TextFileLineCount = TextFileLineCount + 1
Loop
Close #txtfile
For Line = LBound(TextFileLineContent()) To UBound(TextFileLineContent())
RangeContent = Split(TextFileLineContent(Line), Delimeter, -1, vbTextCompare)
For Column = 0 To UBound(RangeContent())
Tabelle1.Cells(Row, Column + 1) = RangeContent(Column)
Next Column
Row = Row + 1
Next Line
ExitSub:Erase TextFileLineContent() 'Löscht das Datenfeld TextFileLineContent
Erase RangeContent() 'Löscht das Datenfeld RangeContent
Exit Sub
ErrHandler:MsgBox Err.Description, vbOKOnly + vbCritical, "Fehler " & Err.Number
Resume ExitSub
End Sub
Nach dem Einfügen des Codes muss die Konstante "StickPath" angepaßt werden. Bitte ändere den Pfad zu dem Laufwerk und dem entsprechenden Verzeichnis und eventuell Unterverzeichnissen. Bitte unbedingt am Ende der Zeichenfolge einen "\" einfügen.
Doppelklicke bitte im Projekt-Explorer auf "DieseArbeitsmappe", damit sich das entsprechende Code-Fenster öffnet.
Das nun folgende Code-Fragment gehört in das Code-Fenster von "DieseArbeitsmappe":
Klicke nun bitte im Menü "Debuggen" auf "Kompilieren von VBAProject". Wenn keine Fehler gemeldet werden, schließe bitte den VisualBasic-Editor, kehre zurück zu Excel und speichere un schließe die Datei.
Wenn Du die Datei nun wieder öffnest, sollte Dir als erstes eine Meldung angezeigt werden. Wenn der Pfad existiert und der Stick Textdateien enthält, wird eine Meldung angezeigt, in der sämtliche, auf dem Stick enthaltenen *.txt angezeigt werden. Wenn Du die Meldung mit "Ja" bestätigst, werden die Dateien eingelesen.
Vielleicht soweit erstmal. Kannst Du ja 'mal ausprobieren.
