Gruppe
Extern
Problem
Die in Zelle B1 genannte Textdatei soll als QueryTable importiert werden. Die Abfragetabelle wird nach dem Import gelöscht.
StandardModule: Modul1
Sub TextImport()
Dim sFile As String
sFile = Range("B1").Value
If Dir(sFile) = "" Then
Beep
MsgBox "Die Textdatei wurde nicht gefunden!"
Exit Sub
End If
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sFile & "", _
Destination:=Range("A3"))
.Name = "test"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.Refresh BackgroundQuery:=False
End With
ActiveSheet.QueryTables(1).Delete
End Sub