Pfadangabe durch Variable ersetzen

Sub Test() Dim wksE As Worksheet Dim Pfad As String Set wksE = Worksheets("Einlesen") Pfad = wksE.Range("R6") If wksE.Range("A3") <> "" Then Exit Sub Else With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;Pfad", Destination:=Range("A1")) xxx '"TEXT;C:\Dokumente und Einstellungen\pc\Eigene Dateien\SBW2005.csv", _ xxx 'Destination:=Range("A1")) .Name = "SBW2005" .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 = True .TextFileCommaDelimiter = True .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Rainer,
nochmal schönen Dank für Deine Mühe. Ich habe immer noch die gleiche Fehlermeldung.
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Pfad & ".csv", Destination:=Range("A1"))
.Name = "SBW2005"
.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 = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
xxxxx .Refresh BackgroundQuery:=False
End With
Die mit xxxx gekennzeichnete Zeile wird vom Debugger gelb gekennzeichnet. Und findet die Textdatei noch immer nicht. :-(
Gruß Korl

Hallo Rene,
erstmal Danke für Deine Bereitschaft und Mühe. Dein Gedanke ist genau der meinige.
Ich bin wieder ein Schritt weiter gekommen, nur so ganz genau weis ich nun nicht wo ich Deine Variablen einbauen muß.
Eigentlich entspricht der Code schon meinen Vorstellungen, was mich nun aber stutzig macht, ist, das nur das File mit einen bestimmten Namen angenommen wird.
In meinem Fall wird nur die "SBW2005.csv" geöffnet. Benenne ich diese um, läßt sie sich nicht öffnen?
Hier nochmal mein Code:


Sub Test()
Dim wksE As Worksheet
Dim x As String
Dim Pfad As String, strFileName As String, strFolders As String
Set wksE = Worksheets("Einlesen")
Pfad = wksE.Range("R6")
strFileName = Application.GetOpenFilename("CSV Files (*.csv), *.csv")
'strFileName = UBound(strFolders)
' strFolders = Split(strFileName, "\")
ChDrive Left(Pfad, 1)
ChDir Pfad
strFileName
If strFileName = "Falsch" Then Exit Sub
On Error Resume Next
Application.ScreenUpdating = False
wksE.Range("A1").Select
With Selection.QueryTable
.Connection = strFileName                   ' "SBW2005.csv"
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'  Call Verarbeitung
Application.ScreenUpdating = True
End Sub

Ich kann in meinen Code nicht entdecken, das der Filename "SBW2005.csv" sein muß.
Kannst Du mir wohl nochmal weiter helfen?
Gruß Korl

Sub LiesCSV1() Dim neudatei neudatei = Application.GetOpenFilename(filefilter:="Textdateien (*.csv), *.csv") If neudatei = False Then Exit Sub ' Bei Bedarf: Neue Tabelle anlegen Worksheets.Add ' LeseFunktion aufrufen ReadfromCSVSimple CStr(neudatei) End Sub

Sub ReadfromCSVSimple(fname As String, Optional FS As String = ";") Dim hfile As Integer ' Filehandle bzw. Dateinummer Dim i As Long ' Zähler über alle Zeilen Dim j As Integer ' Zähler über alle Spalten Dim OneLine As String ' Eine Zeile als String Dim myArr As Variant ' eine Zeile in Felder getrennt hfile = FreeFile Open fname For Input As #hfile While Not EOF(hfile) i = i + 1 Line Input #hfile, OneLine myArr = Split(OneLine, FS) ' With Range(Cells(i, 1), Cells(i, 1 + UBound(myArr))) ' .NumberFormat = "@" ' .Value = myArr ' End With For j = 0 To UBound(myArr) Cells(i, 1 + j).NumberFormat = "@" Cells(i, 1 + j).Value = myArr(j) Next Wend Close #hfile End Sub

Beliebteste Forumthreads (12 Monate)

Pfadangabe durch Variable ersetzen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread