csv-import variable

Sub Makro4_CX() Workbooks.add With ActiveSheet.QueryTables.add(Connection:= _ "TEXT;C:\Users\Peter\Desktop\Text importieren Testb\00Orginaldateien\00Kopierer1csv\ _ Kopierkosten_Halbjahr_2015_16_DC2455.csv" _ , Destination:=Range("$A$1")) .Name = "Kopierkosten_Halbjahr_2015_16_DC2455" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 65001 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = True .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _ 1, 1, 1, _ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Windows("Test2xml.xlsm").Activate End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Peter
versuch mal das hier (ungetestet)
(hier eingetragene Zeilenumbrüche musst du vielleicht entfernen, weil mit ihnen der Code vielleicht nicht funktioniert)

Sub Makro4_CX()
Workbooks.Add
lstrPath As String, lstrFile As String
lstrPath = "C:\Users\Peter\Desktop\Text importieren Testb\00Orginaldateien\00Kopierer1csv\"  _
'anpassen, wenn sich der Pfad zu den csv-Dateien ändert!!
lstrFile = Dir(lstrPath & ".csv")
If lstrFile = "" Then
MsgBox "keine csv-Dateien vorhanden"
Exit Sub
End If
Do Until lstrFile = ""
Cells.Clear
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & lstrPath & lstrFile, Destination:=Range("$A$1"))
.Name = lstrFile
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,  _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
MsgBox "nur ein zwischenstopp, weil nach klick auf ok automatisch die nächste csv- _
datei eingelesen wird"
lstrFile = Dir
Loop
Windows("Test2xml.xlsm").Activate
End Sub

Hilfts?
Ciao
Thorsten

Hallo Oberschlumpf,
besten Dank für Deine Hilfe.
Habe den Code ebenfalls bereits fertig. Ich nehme jedoch direkten Bezug zur Tabelle:
Dim fname As String
'fname = Worksheets("Tabelle1").Range("A1")
fname = Workbooks(1).Worksheets(1).Range("A2") & "\" & Workbooks(1).Worksheets(1).Range("A3") & "\" & Workbooks(1).Worksheets(1).Range("B3") & "\" & Workbooks(1).Worksheets(1).Range("H2")
Workbooks.add
With ActiveSheet.QueryTables.add(Connection:= _
"TEXT;" & fname, _
Destination:=Range("$A$1"))
.Name = Left(fname, Len(fname) - 4)
Was ich jedoch bei Deiner Version super finde ist die Überprüfung ob eine Datei vorhanden ist.
Dies werde ich bei mir noch einfügen.
Nochmals besten Dank für Deine Hilfe und noch einen schönen Sonntag.
Gruss Peter

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread