Option Explicit
Sub MkInput()
Const ZEICHEN As Long = 4
Dim oFso As Object
Dim oStream As Object
Dim oFile As Object
Dim strTextline As String
Dim strFilename As String
Dim strTabname As String
Dim arrZeile() As String
Dim lngSpalten As Long
Dim blnRedim As Boolean
Dim x As Long, y As Long, z As Long
Dim c As Range
On Error GoTo MkInput_Error
Set oFso = CreateObject("Scripting.FileSystemObject")
strFilename = "C:\VBA\Rasterdaten.txt"
strTabname = Replace(strFilename, ".txt", "")
strTabname = Replace(strTabname, "\", " ")
strTabname = Replace(strTabname, ":", " ")
Sheets.Add
ActiveSheet.Name = strTabname
Set oFile = oFso.GetFile(strFilename)
Set oStream = oFile.OpenAsTextStream(1, -2)
Do While oStream.AtEndOfStream <> True
strTextline = oStream.ReadLine
If Not blnRedim Then
lngSpalten = Len(strTextline) / ZEICHEN
ReDim arrZeile(1 To lngSpalten)
blnRedim = True
End If
For x = 1 To Len(strTextline) Step ZEICHEN
y = y + 1
arrZeile(y) = Mid(strTextline, x, ZEICHEN)
Next x
z = z + 1
y = 0
Set c = Cells(z, 1)
Set c = c.Resize(1, UBound(arrZeile))
c.Value = arrZeile
Loop
oStream.Close
On Error GoTo 0
MkInput_Error:
Select Case Err.Number
Case Is = 0:
Case Is = 1004
Call MsgBox("umbenenen oder löschen!", vbCritical, "Abbruch - Tabelle vorhanden")
Case Else:
Call MsgBox(Format(Err.Number, " #0") & "/" & _
Err.Description, vbExclamation, "Code Fehler")
End Select
End Sub