Da der Beitrag schon älter ist, kopiere ich den Thread nochmal hier rein:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Hallo,
ich bin gerade dabei ein Makro zu schreiben, mit dem man Daten von einer Messsoftware (aus mehreren Dateien) in Excel importieren kann.
Es handelt sich dabei um mpt Dateien, was eine Art tab-separierte Textdatei ist, wenn ich es richtig verstanden habe. Ich kann diese Dateien jedenfalls problemlos mit Excel öffnen und die Daten erscheinen auch getrennt in Reihen und Spalten im richtigen Format.
Nur wenn ich mein Skript zum Importieren benutze, zerhäckselt es mir das Datenformat :(
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Hallo Clemens,
ich würde die *.mtp-Datei nicht mit 'Workbooks.Open(...)' öffnen, das diesee kein Stamdardtyp für Excel ist (laut Vba-Hilfe: Öffnet eine Arbeitsmappe).
Für sowas gibt es doch 'QueryTables.Add(...)' - Da kann man verschiedene Parameter angeben.
Gruß von Luschi
aus klein-Paris
~~~~~~~~~~~~~~~~~~~~~~~
Hallo Luschi,
danke, damit funktioniert es tatsächlich:
Sub Import()
Dim Str1 As String
Dim i As Integer
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "mpt files (*.mpt)", "*.mpt"
.Filters.Add "all files (*.*)", "*.*"
.Show
If .SelectedItems.Count > 0 Then
For i = 1 To .SelectedItems.Count
If Worksheets.Count
Jetzt will ich nur noch, dass die einzelnen Sheets so wie die Dateien heißen, aus denen die Daten jeweils importiert wurden. Kann mir jemand sagen, wie ich das in den Code eingebaut bekomme?
Sorry, bin VBA Anfänger :(
Gruß, Clemens
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Hallo Clemens,
benutze dafür ein Worksheet-Obnjekt:
Dim ws As Worksheet
Dim j1 As Integer, j2 As Integer, s As String
Set ws = Worksheets.Add(After:=Worksheets(i - 1))
'weiterer Vba-Code und dann
'letztes '\'-Zeichen im Pfad + Dateiname ermitteln
j1 = InStrRev(SelectedItems.Item(i), "\", -1, vbTextCompare)
'Dateiname ohne Pfad
s = Mid(SelectedItems.Item(i), j1 + 1)
'letzten Punkt im Dateinamen
j2 = InStrRev(s, ".", -1, vbTextCompare)
s = Left(s, j2 - 1)
ws.Name = s
'...
' und jetzt statt ActiveSheet ws einsetzen
' ganz zum Schluß!
Set ws = Nothing
Gruß von Luschi
aus klein-Paris
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
So, ich habe das mittlerweile (endlich...) mal ausprobiert, aber eventuell nicht ganz richtig verstanden, wie ich den Vorschlag von Luschi umsetze.
Mein Code sieht so aus:
Sub Import()
Dim Str1 As String
Dim i As Integer
Dim ws As Worksheet
Dim j1 As Integer, j2 As Integer, s As String
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "mpt files (*.mpt)", "*.mpt"
.Filters.Add "all files (*.*)", "*.*"
.Show
If .SelectedItems.Count > 0 Then
For i = 1 To .SelectedItems.Count
If Worksheets.Count
Vermutlich habe ich den Vorschlag von Luschi falsch verstanden, jedenfalls bekomme ich immer den "Run time error 424: object required" in der Zeile:
j1 = InStrRev(SelectedItems.Item(i), "\", -1, vbTextCompare)
Weiß jemand was das Problem ist?
Danke für die Hilfe & viele Grüße,
Clemens