nur einige Daten aus TXT Datei

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;C:\Pfad\100417.txt", Destination:=Range("$A$1")) .CommandType = 0 .Name = "100417" .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 = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = True .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 9, 9, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With

Hallo André,
teste mal. Importiert wird in die Tabelle1!

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub importTXT()
Dim objADO As Object, objRS As Object
Dim strPath As String, strFile As String, strSQL As String
Dim lngI As Long

With Application.FileDialog(msoFileDialogFilePicker)
  .InitialFileName = "E:\Forum"
  .Title = "Datei auswählen"
  .ButtonName = "Import Starten"
  .Filters.Clear
  .Filters.Add "Text Dateien", "*.txt; *.csv", 1
  .Filters.Add "Alle Dateien", "*.*", 2
  .FilterIndex = 1
  .InitialView = msoFileDialogViewList
  If .Show = -1 Then strFile = .SelectedItems(1)
End With

strPath = Mid(strFile, 1, InStrRev(strFile, "\"))
strFile = Mid(strFile, InStrRev(strFile, "\") + 1)

If Len(strFile) Then
  With Sheets("Tabelle1")
    .UsedRange.ClearContents
    If MakeSchemaINI(strFile, strPath) Then
      Set objADO = CreateObject("ADODB.CONNECTION")
      objADO.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strPath & _
        "; Extended Properties=""text; HDR=Yes; FMT=Delimited; IMEX=1;"""
      Set objRS = CreateObject("ADODB.RECORDSET")
      strSQL = "SELECT [Teil3],[Beschreibung3],[Teil1],[Beschreibung1] From [" & strFile & "]"
      objRS.Open strSQL, objADO, 3, 1, 1
      If Not objRS.EOF Then
        For lngI = 1 To objRS.Fields.Count
          .Cells(1, lngI) = objRS.Fields(lngI - 1).Name
        Next
        .Cells(2, 1).CopyFromRecordset objRS
      End If
      objRS.Close
      objADO.Close
    End If
    .Columns.AutoFit
  End With
End If
End Sub

Private Function MakeSchemaINI(FileName As String, Path As String) As Boolean
Dim strFile As String, strText As String
Dim ff As Integer

MakeSchemaINI = True

On Error GoTo ErrExit

If Right(Path, 1) <> "\" Then Path = Path & "\"

strFile = Path & "Schema.ini"


strText = "[" & FileName & "]" & vbCrLf & _
  "Format=Delimited(;)" & vbCrLf & _
  "ColNameHeader=True" & vbCrLf & _
  "MaxScanRows=0" & vbCrLf


ff = FreeFile

Open strFile For Output As #ff
Print #ff, strText;
Close #ff

Exit Function

ErrExit:
MakeSchemaINI = False
End Function

Gruß Sepp

Private Function MakeSchemaINI(FileName As String, Path As String) As Boolean Dim strFile As String, strText As String Dim ff As Integer MakeSchemaINI = True On Error GoTo ErrExit If Right(Path, 1) <> "\" Then Path = Path & "\" strFile = Path & "Schema.ini" strText = "[" & FileName & "]" & vbCrLf & _ "Format=Delimited(;)" & vbCrLf & _ "ColNameHeader=True" & vbCrLf & _ "MaxScanRows=0" & vbCrLf & _ "Col1=Teil1 Long" & vbCrLf & _ "Col2=Beschreibung1 Text" & vbCrLf & _ "Col3=Teil3 Long" & vbCrLf & _ "Col4=Beschreibung3 Text" & vbCrLf ff = FreeFile Open strFile For Output As #ff Print #ff, strText; Close #ff Exit Function ErrExit: MakeSchemaINI = False End Function

strText = "[" & FileName & "]" & vbCrLf & _ "Format=Delimited(;)" & vbCrLf & _ "ColNameHeader=True" & vbCrLf & _ "MaxScanRows=0" & vbCrLf & _ "Col1=Teil1 Long" & vbCrLf & _ "Col2=Beschreibung1 Text" & vbCrLf & _ "Col3=Teil2 Long" & vbCrLf & _ "Col4=Beschreibung2 Text" & vbCrLf & _ "Col5=Teil3 Long" & vbCrLf & _ "Col6=Beschreibung3 Text"

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

nur einige Daten aus TXT Datei

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread