umstellen auf "Environ Username (?)"

Forumthread: umstellen auf "Environ Username (?)"

12.12.2014 08:26:04

Wolfgang

Hallo,
den nachfolgenden Code habe ich mit dem Makrorekorder aufgezeichnet und versucht, ihn mit meinem folgenden Wunsch anzupassen. Ich würde nun gerne erreichen, dass die Zuweisung der Textdatei nicht namentlich erfolgt, sondern "userbezogen"(Environ Username?), irgendwie bekomme ich das nicht hin. Angesprochen wird die Textdatei "test.txt", die sich auf dem Desktop im Ordner Abfrage_neu befindet. Was mache ich falsch? - Danke schon jetzt für die Rückmeldungen und Unterstützung.
Gruß - Wolfgang


Sub Texteinfügen()
Worksheets("Textimport").Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\Environ("Username")\Desktop\Abfrage_neu\test.txt", Destination:=Range("A2"))
.Name = "test"
.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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: umstellen auf "Environ Username (?)"

12.12.2014 08:29:23

mumpel

Hallo!
"TEXT;" & Environ("USERPROFILE") & "\Desktop\Abfrage_neu\test.txt"
Gruß, René

AW: umstellen auf "Environ Username (?)"

12.12.2014 08:31:22

Tino

Hallo,
versuch es so.

"TEXT;C:\Users\" & Environ("Username") & "\Desktop\Abfrage_neu\test.txt"

oder so

"TEXT;" & Environ("USERPROFILE") & "\Desktop\Abfrage_neu\test.txt"

Gruß Tino

Danke Rene und Tino, eine Frage noch.

12.12.2014 08:46:49

Wolfgang

Hallo Rene und Tino,
herzlichen Dank für die schnelle Rückmeldung und die Änderungen zum Code. Der Code läuft damit nun wunderbar.
Nicht mehr im Zusammenhang, aber den Code betreffend hätte ich noch eine ergänzende Frage:
Der Text wird nun in Tabelle "Textimport", Spalte A eingefügt (zeilenweise). Wie kann der Code noch angepasst werden, damit keine Leerzeilen erzeugt werden, sondern der Text nahtlos Zeile für Zeile eingefügt wird? - Danke schon jetzt auch wieder für die Rückmeldung.
Gruß - Wolfgang

AW: Danke Rene und Tino, eine Frage noch.

12.12.2014 09:25:35

Tino

Hallo,
versuch mal so, Referenz ist die Spalte 1 im Benutzten Bereich.

Sub Texteinfügen()
Worksheets("Textimport").Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Environ("USERPROFILE") & "\Desktop\Abfrage_neu\test.txt", _
Destination:=Range("A2"))
.Name = "test"
.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
LoescheLeer Worksheets("Textimport") 'oder auch ActiveSheet
End Sub
Sub LoescheLeer(oWS As Worksheet)
Dim rng As Range, rngTmp As Range, iCalc%
iCalc = Application.Calculation
Application.Calculation = xlCalculationManual
With oWS
Set rng = .UsedRange.Columns(1)
Set rngTmp = .UsedRange.EntireRow.Columns(.Columns.Count)
rngTmp.FormulaR1C1 = "=IF(RC" & rng.Column & "="""",TRUE,ROW())"
If Application.WorksheetFunction.CountIf(rngTmp, True) > 0 Then
rngTmp.EntireRow.Sort Key1:=rngTmp.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
rngTmp.SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
End If
rngTmp.EntireColumn.Delete
End With
Application.Calculation = iCalc
End Sub

Gruß Tino

Danke Tino - klappt super

12.12.2014 11:05:28

Wolfgang

Hallo Tino,
erneut herzlichen Dank für Deine schnelle Rückmeldung. Habe die Ergänzungen eingebaut. Der Code läuft super und habe nun keine Leerzeilen mehr.
Nochmals recht herzlichen Danke und ein schönes Wochenende.
Gruß - Wolfgang

Beliebteste Forumthreads (12 Monate)

umstellen auf "Environ Username (?)"

Forumthread: umstellen auf "Environ Username (?)"

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

umstellen auf "Environ Username (?)"

Forumthread: umstellen auf "Environ Username (?)"

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread