Ich würde gerne Messdaten aus mehreren Textdateien (*.tra) mit Hilfe eines Makros in Excel importieren. Die Dateien befinden sich alle in einem Ordner.
Der Import über "Daten" -> "Externe Daten importieren" -> "Daten importieren" klappt soweit ganz gut. Da ich jedoch teilweise hundert oder mehr Textdateien habe, ist das natürlich sehr mühsam.
Da ich mehrere Messungen für eine Probe gemacht habe, sind die Dateien folgendermaßen benannt:
NameA1.tra; NameA2.tra; NameA3.tra usw.
Hier mal ein Auszug aus einer solchen Datei. Die Zahlenwerte von Prüfzeit, Standardkraft und Dehnung sind durch Tab getrennt.
"Datum" "15.06.2010"
"Probennummer" 1 ""
"Probenbreite b0" 4,2 "mm"
"Probendicke a0" 2,2 "mm"
"Geschwindigkeit E-Modul" 200 "mm/min"
"Prüfgeschwindigkeit" 200 "mm/min"
"E-Modul" "nicht bekannt"
"Dehnung bei Fmax" 301,402 "%"
"Kraftmaximum" 5,47781 "MPa"
"Dehnung bei Bruch" 305,659 "%"
"Bruchkraft" 5,38083 "MPa"
"Prüfzeit" "Dehnung" "Standardkraft"
"s" "%" "MPa"
0,0399951 0,000750504 -0,0218694
0,359995 0,0040005 -0,0256728
0,379995 0,0040005 -0,0209186
0,399995 0,0037505 -0,0237711
0,439995 0,0050005 -0,0228203
0,459995 0,0057505 -0,0199677
Ich würde das gerne so machen, dass ich beim Abspielen des Makros die erste Datei, also NameA1.tra auswähle und alle weiteren mit NameA in das gleiche Tabellenblatt importiert werden.
Ich habe den Import einer einzelnen Datei mal mit dem Makrorecorder aufgezeichnet.
Sub TraImport()
' TraImport Makro
' Makro am 22.06.2010 von Mark aufgezeichnet
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;M:\Rohdaten Zugversuche\XXXXXX\XXXXX_Zug_Komplett1.TRA", Destination _
:=Range("A1"))
.Name = "XXXXX_Zug_Komplett1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1250
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Vielleicht kann mir jemand in der Sache weiterhelfen. Ich bin noch totaler Newbie, was VBA angeht.
Danke schonmal!
Gruß
Mark