VBA Datei öffnen Abfrage und Weitergabe als Variable

Lennart12

Cadet 3rd Year
Dabei seit
Aug. 2018
Beiträge
35
Hallo zusammen,

ich sitze gerade an meinem ersten VBA Projekt und komme bei einem Makro nicht so recht weiter.
Das folgende Makro funktioniert und mit einem Klick wird eine bestimmte Textdatei an die Stelle A8 korrekt eingefügt.
Allerdings handelt es sich nicht immer um diese Datei.
Ich möchte, dass sich mit klick auf das Makro zunächst:
-das Explorerfenster öffnet mit einem vordefinierten Pfad, sodass ich nur noch ein oder zwei Ordner weiter auswählen muss, bis ich die gewünschte Textdatei auswählen kann
-mit dieser Textdatei soll dann das untenstehende Makro ausgeführt werden.

Meine Idee war, den Pfad als Variable zu speichern und das "hier steht der Phad durch die Variable zu ersetzen, aber das klappt nicht.

Sub Textdatei_importieren()
'
' Textdatei_importieren Makro

Columns("A:K").Select
Selection.ClearContents
Range("A8").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;hier steht der Pfad" _
, Destination:=Range("$A$8"))
.Name = "hier steht der Name der Datei"
.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 = xlTextQualifierNone
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

Es wäre richtig klasse, wenn mir jemand helfen könnte.
Danke im Voraus!
 

ella_one

Lieutenant
Dabei seit
Aug. 2006
Beiträge
754
Das ist nicht trivial! Dafür benötigst Du einige Windows-API Aufrufe und das FileSystem Objekt, welches u.a. auch einen FileDialog zur Verfügung stellt.
Die Suchgöttin Google dürfte brauchbare Ergebnisse liefern.
 
Dabei seit
Apr. 2021
Beiträge
2
Versuch das mal.

Public Sub Test()
Dim strPath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.InitialFileName = "C:\Windows\System32\" 'hier Deinen Pfad angeben
.Title = "Ordner auswählen"
If .Show Then strPath = .SelectedItems(1)
End With
If strPath <> vbNullString Then
MsgBox strPath
End If
End Sub

Gruß,
Tom.
 

Lennart12

Cadet 3rd Year
Ersteller dieses Themas
Dabei seit
Aug. 2018
Beiträge
35
Das ist nicht trivial! Dafür benötigst Du einige Windows-API Aufrufe und das FileSystem Objekt, welches u.a. auch einen FileDialog zur Verfügung stellt.
Die Suchgöttin Google dürfte brauchbare Ergebnisse liefern.
Das klingt ja nicht so gut:confused_alt: google habe ich gefühlt alles ausprobiert, ich konnte auch die Datei auswählen, aber beim Einfügen in das oben angefügte Makro war Schluss.
Das beste Ergebnis lieferte bisher dieses, womit ich die Datei jedenfalls öffnen kann.
'** Dimensionierung der Variablen
Dim wb As Workbook
Dim ws As Worksheet
Dim lngZ As Long
Dim strFileName
Dim strFilter As String

'** Dateifilter definieren
strFilter = "Text-Dateien(.txt), .txt"
'**Pfad definieren, welcher geöffnet werden soll
ChDir "hier steht dann der Pfad"
'** Den im Dialogfeld gewählten Namen auslesen
strFileName = Application.GetOpenFilename(strFilter)
'** Prüfen, ob eine gültige Datei ausgewählt wurde
If strFileName = False Then Exit Sub
'** Gewählte Datei öffnen
Set wb = Workbooks.Open(strFileName)
Versuch das mal.

Public Sub Test()
Dim strPath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.InitialFileName = "C:\Windows\System32\" 'hier Deinen Pfad angeben
.Title = "Ordner auswählen"
If .Show Then strPath = .SelectedItems(1)
End With
If strPath <> vbNullString Then
MsgBox strPath
End If
End Sub

Gruß,
Tom.
Moin Tom,
erstmal danke für die Hilfe. Hier öffne ich aber ja nur den Ordner und nicht die Datei?
Ich habe dann so wie ich das verstehe den Pfad zum Ordner dann als Variable strPath gespeichert, aber das hilft mir ja auch nicht weiter.
Ich muss ja den Phad mit der Datei am Ende am Ende hier eintragen, wenn das überhaupt geht, dass ich den Pfad durch eine Variable ersetze:
ActiveSheet.QueryTables.Add(Connection:= _"TEXT;hier steht der Pfad" _, Destination:=Range("$A$8"))
 

Lennart12

Cadet 3rd Year
Ersteller dieses Themas
Dabei seit
Aug. 2018
Beiträge
35
Da hätte man drauf kommen können :D Danke!

Hat geklappt mit
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" + strPath, Destination:=Range("$A$8"))
Vielen Dank für Eure Hilfe!!
 
Zuletzt bearbeitet:

Bonanca

Commander
Dabei seit
Aug. 2015
Beiträge
2.186

Wurzelsepp29

Ensign
Dabei seit
Nov. 2009
Beiträge
197
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" + strPath, Destination:=Range("$A$8"))
Ergänzend vielleicht noch: Vermeide .Select und Referenzierungen mit ActiveSheet/ActiveCell, da diese während der Programmlaufzeit wechseln können und somit eine eindeutige Referenzierung nicht gegeben ist.
Das Programm wird robuster, wenn Du vorgibst, wo das ablaufen soll.
 

Lennart12

Cadet 3rd Year
Ersteller dieses Themas
Dabei seit
Aug. 2018
Beiträge
35
Ergänzend vielleicht noch: Vermeide .Select und Referenzierungen mit ActiveSheet/ActiveCell, da diese während der Programmlaufzeit wechseln können und somit eine eindeutige Referenzierung nicht gegeben ist.
Das Programm wird robuster, wenn Du vorgibst, wo das ablaufen soll.
Danke für deinen guten Beitrag! Als Anfänger sind solche Tipps natürlich Gold wert.
Das ist tatsächlich auch ein Problem, worüber ich gerade gestolpert bin, da ich mit einem Makro mehrere Makros auf anderen Tabellenblättern aktivieren wollte, was mit Active sheet natürlich nicht klappte...
Also verstehe ich daraus, dass ich statt
ActiveSheet.QueryTables.Add(Connection:="TEXT;" + strPath, Destination:=Range("$A$8"))
lieber
Tabelle1.QueryTables.Add(Connection:="TEXT;" + strPath, Destination:=Range("$A$8"))
verwende.


Hier ist mir das noch nicht ganz klar mit Select (ein anderes von mir geschriebenes Makro, filtert von Tabelle 1 (=Partlist) nach Tabelle2):

Sub Test()

Columns("A:J").Select
Selection.ClearContents
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Sheets("Partlist").Range("A7:J10341").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("V1:W2"), CopyToRange:=Range("A7"), Unique:=False
Columns("J:J").Select
With Selection
.HorizontalAlignment = xlFill
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A7").Select
Range("A7:J175").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("AA1:AB2"), Unique:=False
End Sub

Dieses müsste ich dann ja ändern zu:
Sub Test()
Columns("A:J").Tabelle2
Tabelle2.ClearContents
With Tabelle2.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Sheets("Partlist").Range("A7:J10341").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("V1:W2"), CopyToRange:=Range("A7"), Unique:=False
Columns("J:J").Tabelle2
With Tabelle2
.HorizontalAlignment = xlFill
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A7").Tabelle2
Range("A7:J175").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("AA1:AB2"), Unique:=False
End Sub
Da gibts dann aber gleich in Zeile 2 eine Fehlermeldung.
 

Janush

Lieutenant
Dabei seit
Mai 2008
Beiträge
512
Nein, aus:

Sub Test()

Columns("A:J").Select
Selection.ClearContents
With Selection.Interior

wird:

With Columns("A:J")
.ClearContents
With .Interior
....
End With
End With
 
Top