Clever-Excel-Forum

Hey,

ich habe folgendes Problem:

ich versuche derzeit ein Macro zu erstellen, welches Daten aus Excel-Datein in meine aktuelle Excel-Datei importiert. Zu diesem Zweck, zeichne ich das Macro. Soweit funktioniert es auch. Nun will ich das Macro jedoch dahingehend verändern, dass das Macro den Speicherort der Excel-Datei selbstständig erkennt und diesen Pfad benutzt um die gefragten Exceldateien zu importieren. Mein funktionierender Code sieht folgendermasen aus:

Sub Dateiimport()
'
' Dateiimport Makro
'

'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\loehndorf\Desktop\Excel Test\Tabellen Pinfin 3_6 60°C 0.05\Nusselt.csv" _
, Destination:=Range("$A$1"))
.Name = "Nusselt"
.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 = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-30
End Sub

Der angegebene Pfad (C:\Users\loehndorf\Desktop\Excel Test\Tabellen Pinfin 3_6 60°C 0.05\Nusselt.csv") soll jetzt dahingehend umgeschrieben werden, dass das Makro den vom Speicherort der Datei aus in den Unterordner "Tabellen Pinfin 3_6 60°C 0.05" geht, in welcher sich die zu importierende Exceldatei befindet. Ich habe es auf folgende weise probiert:

With ActiveSheet.QueryTables.Add(Connection:= _

"TEXT;\Nusselt.csv" _

Führe ich das Makro danach aus bekomme ich folgenden Fehler:

"Laufzeitfehler '1004':

Excel kann die Textdatei für die Aktualisierung des externen Datenbereichs nicht finden.

Vergewissern Sie sich, dass die Textdatei nicht verschoben oder umbenannt wurde.
Wiederholen die anschließend die Aktualisierung."

Im Debugger wird die 4. letzte Zeile markiert:

.Refresh BackgroundQuery:=False

Ich bin für jede Hilfe sehr dankbar,

Gruß maettlo

Hallo,

teste mal so:

Code:
Sub Dateiimport()

'

' Dateiimport Makro

Dim pfad As String

Dim Datei As String

pfad = ActiveWorkbook.Path

meineDatei = "Nusselt.csv"

'

    With ActiveSheet.QueryTables.Add(Connection:= _

        "TEXT;" & pfad & "\" & meineDatei, Destination:=Range _

        ("$A$1"))

        .Name = "Etiketten"

        .FieldNames = True

        .RowNumbers = False

        .FillAdjacentFormulas = False

        .PreserveFormatting = True

        .RefreshOnFileOpen = False

        .RefreshStyle = xlInsertDeleteCells

        .SavePassword = False

        .SaveData = True

        .AdjustColumnWidth = True

        .RefreshPeriod = 0

        .TextFilePromptOnRefresh = False

        .TextFilePlatform = 1252

        .TextFileStartRow = 1

        .TextFileParseType = xlDelimited

        .TextFileTextQualifier = xlTextQualifierDoubleQuote

        .TextFileConsecutiveDelimiter = False

        .TextFileTabDelimiter = True

        .TextFileSemicolonDelimiter = False

        .TextFileCommaDelimiter = False

        .TextFileSpaceDelimiter = False

        .TextFileColumnDataTypes = Array(1, 1)

        .TextFileTrailingMinusNumbers = True

        .Refresh BackgroundQuery:=False

    End With

End Sub

Hey atilla,

erstmal großes Dankeschön für deine schnelle Antwort. Dein Code funktioniert wunderbar. Ich habe ihn noch etwas verändert um noch weitere Dateien importieren zu können.
Hier meine Anpassung, falls jemand ein ähnliches Problem haben sollte.

Sub Dateiimport()
'
' Dateiimport Makro
'

Dim pfad As String
Dim Datei As String
pfad = ActiveWorkbook.Path
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & pfad & "\Nusselt.csv", Destination:=Range("$A$1"))
.Name = "Nusselt"
.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 = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Tabelle2").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & pfad & "\Wärme.csv", Destination:=Range("$A$1"))
.Name = "Wärme"
.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 = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

Nochmals Danke, schlönes Wochende.