Einlesen von Textdateien

Guten Tag,
Ich habe mir aus mehreren Quellen ein VBA Makro zusammen gestellt und auch bereits darin editiert.
Zuerst öffne ich mit eine Dialog die Datei Auswahl
Fname = Application.GetOpenFilename( _
FileFilter:="BDE Mis Files (*.mis), *.mis", _
Title:="Select file", _
MultiSelect:=True)
Und speichere das gewählte Verzeichnis
WorkPath = CurDir
Dann möchte ich die ERSTE GEFUNDENE DATEI im Array Fname verwenden um meine Zeilen Bezeichnungen zu setzen.
If IsArray(Fname) Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;D:\Auswertung\bde00.mis", Destination:=Range("$A2"))
ActiveSheet.Name = "BDE Auswertung"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "="
.TextFileColumnDataTypes = Array(1, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
For N = LBound(Fname) To UBound(Fname)
Next N
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
Dies funktioniert nur solange in der Query Connection der absolute Pfad steht.
Sobald ich mit variablen arbeite findet er die Datei nicht mehr.
Wie ist diese richtig zu setzen?
Vielen Dank schonmal.
Dennis

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Dennis,
das Array fname mit den ausgewählten Dateien enthält immer den kompletten Pfad+Name der Dateien.
Das Workspace-Verzeichnis benörigst du hier nicht.
Nachfolgend meine Anpassung/Ergänzung deines Makros.
Gruß
Franz

Sub mis_Files_laden()
Dim fname
Dim FileName
Dim lZeile As Long, lSpalte As Long
fname = Application.GetOpenFilename( _
FileFilter:="BDE Mis Files (*.mis), *.mis", _
Title:="Select file", _
MultiSelect:=True)
If Not IsArray(fname) Then GoTo Beenden
'Und speichere das gewählte Verzeichnis
'Dann möchte ich die ERSTE GEFUNDENE DATEI im Array Fname verwenden um _
meine Zeilen Bezeichnungen zu setzen.
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
ActiveSheet.Name = "BDE Auswertung"
lZeile = 2
lSpalte = 1
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & fname(1), Destination:=Cells(lZeile, lSpalte))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "="
.TextFileColumnDataTypes = Array(1, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
For Each FileName In fname
'nächste Einfügezeile/Spalte
With ActiveSheet.UsedRange
'lZeile = .Row + .Rows.Count 'Wenn untereinander
lSpalte = .Column + .Columns.Count 'Wenn nebeneinander
End With
'Dateiname in Zeile 1 eintragen
ActiveSheet.Cells(1, lSpalte) = Mid(FileName, InStrRev(FileName, Application. _
PathSeparator) + 1)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & FileName, Destination:=Cells(lZeile, lSpalte))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "="
.TextFileColumnDataTypes = Array(9, 1)   '?
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Beenden:
End Sub

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread