Macro

[maettlo]

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

[atilla]

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

[maettlo]

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.