VBA Datei öffnen Abfrage und Weitergabe als Variable

Lennart12

Banned
Registriert
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!
 
  • Gefällt mir
Reaktionen: Conqi
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.
 
  • Gefällt mir
Reaktionen: Lennart12
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.
 
  • Gefällt mir
Reaktionen: spcqike und Lennart12
ella_one schrieb:
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)
Kaffeebecher75 schrieb:
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"))
 
Aso...
dann ersetze einfach die
With Application.FileDialog(msoFolderDialogFolderPicker)
Durch
With Application.FileDialog(msoFileDialogFilePicker)
dann hast Du den kompletten Pfad und die Datei in der Variablen strpath

Gruß,
Tom.
 
  • Gefällt mir
Reaktionen: Lennart12, spcqike und ella_one
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:
Lennart12 schrieb:
Das & Zeichen ist ein Concat, wenn außerhalb eines Strings verwendet.
Du hast gerade einfach nur einen String mit dem obigen Namen.
Wenn du "Text;<strPath>" (mit <strPath> als wert der variable) haben willst, musst du "Text;" & strPath einsetzen.
 
  • Gefällt mir
Reaktionen: Lennart12
Lennart12 schrieb:
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.
 
  • Gefällt mir
Reaktionen: Lennart12 und Bonanca
Wurzelsepp29 schrieb:
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.
 
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
 
  • Gefällt mir
Reaktionen: Lennart12
Zurück
Oben