Erfolg
02.03.2010 01:58:20
Sascha
Hallo Sepp
Durch deine hilfe hat das auch super geklappt und hab es auch noch um 2 sachen erweitern können.
Nun verstehe ich auch warum du die txt datei benötigt hast weil das Makro die Zahlen Zählt und dann einfügt.
Grüsse Sascha
https://www.herber.de/bbs/user/68314.xls
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub importTXT()
Dim strFile As String
Dim lngRow As Long
On Error GoTo ErrExit
strFile = Application.GetOpenFilename("Text Dateien (*.txt),*.txt")
If strFile = CStr(False) Then GoTo ErrExit
With Application
.EnableEvents = False
.DisplayAlerts = False
End With
With Sheets("Tabelle1")
lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
With .QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=.Cells(lngRow, 1))
.Name = Left(strFile, Len(strFile) - 3)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 9, 1, 9, 1, 9, 1, 9, 1, 9, 5, 9)
.TextFileFixedColumnWidths = Array(3, 9, 4, 4, 4, 9, 6, 1, 6, 38, 8)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
.Columns("A:E").AutoFit
End With
ErrExit:
With Err
If .Number 0 Then MsgBox "Fehler " & .Number & vbLf & vbLf & _
.Description & vbLf & vbLf & "In Prozedur (importTXT) in Modul Modul2", _
vbExclamation, "Fehler in Modul2 / importTXT"
End With
With Application
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub