ich suche nach einer Möglichkeit alle Textdateien eines Verzeichnisses in ein Tabellenblatt (nicht in eine Arbeitsmappe) zu importieren .
Wer kann helfen ?
Sub Multi_Text_Import()
'by Josef Ehrensberger
Dim n As Integer
Dim strTemp As String
Dim lRow As Long, i As Long
Dim wks As Worksheet
lRow = 1 'Startzeile in der Tabelle
Set wks = ActiveSheet
With Application.FileSearch
.LookIn = "D:\Office\Excel\Text" 'Pfad zu deinen Textdateien
.FileType = msoFileTypeAllFiles
.Filename = "*.txt"
.SearchSubFolders = False
'(True) wenn auch Unterordner durchsucht werden sollen
.Execute
For n = 1 To .FoundFiles.Count
'Import Textfile
Open .FoundFiles(n) For Input As #1
Do While Not EOF(1)
Input #1, strTemp
wks.Cells(lRow, 1) = strTemp
lRow = lRow + 1
Application.StatusBar = lRow
If lRow = 65536 Then
i = i + lRow - 1
wks.Name = i
wks.Columns("A:A").TextToColumns Destination:=wks.Range("A1"), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1))
wks.Columns.AutoFit
Set wks = Sheets.Add(after:=wks)
lRow = 1
End If
Loop
Close #1
Next
End With
i = i + lRow - 1
wks.Name = i
wks.Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1))
wks.Columns.AutoFit
Application.StatusBar = False
End Sub
wks.Cells(lRow, 1) = strTemp
auszutauschen mit
wks.Cells(lRow, 1) = Replace(strTemp, ",", ".")