Name einer Datei speichern

Question

Hallo alle VBA´ler,

in meinem Verzeichnis C:\Daten befinden sich ausschließlich EXCEL-Dateien. Ich habe eine Datei in einem anderen Verzeichnis geöffnet und arbeite darin. In dieser Datei möchte ich folgendes erreichen:

Es soll mir eine Liste der im Verzeichnis C:\Daten vorhandenen Dateien (am besten ohne Suffix .xls) angeboten werden.

Durch Anklicken eines der Dateinamen soll dieser in der Variablen "Name" gespeichert werden.

Leider reichen meine VBA-Kenntnisse hierzu nicht mehr aus, aber vielleicht bei jemandem von euch. Wäre ganz wichtig, wenn da jemand helfen könnte.

Liebe Grüße
Peter

Answer 1

Hallo Peter,
in ein Modul der Tabelle vom anderen Verzeichnis einfügen und das Makro "Suchen" starten.
Pfad und Dateiname wird angezeigt.

Gruß
fedjo

Private z!
Sub Suchen()
Dim Laufwerk$, Dateien$
z = 2
[a2:c5000] = ""
Laufwerk = "C:\Daten"
If Laufwerk = "" Then Exit Sub
Dateien = "*.xls"
Dateisuche Laufwerk, Dateien
Application.StatusBar = False
End Sub
Sub Dateisuche(Laufwerk, Dateien)
Dim tmp, Wdhlg
On Error Resume Next
If Right(Laufwerk, 1) <> "\" Then Laufwerk = Laufwerk + "\"
tmp = Dir(Laufwerk & Dateien)
Do While Len(tmp)
Cells(z, 1) = Pfad(Laufwerk & tmp)
Cells(z, 2) = Datei(Laufwerk & tmp)
z = z + 1
tmp = Dir()
Loop
tmp = Dir(Laufwerk, vbDirectory)
Do While Len(tmp)
Application.StatusBar = Laufwerk & tmp
If (tmp <> ".") And (tmp <> "..") Then
If (GetAttr(Laufwerk & tmp) And vbDirectory) = vbDirectory Then
Dateisuche Laufwerk & tmp, Dateien
z = z - 1
Wdhlg = Dir(Laufwerk, vbDirectory)
z = z + 1
Do While Wdhlg <> tmp
Wdhlg = Dir()
Loop
End If
End If
tmp = Dir()
Loop
On Error GoTo 0
Application.StatusBar = False
End Sub
Function Datei(Wert As String) As String
Do While InStr(Wert, "\") <> 0
Wert = Right(Wert, Len(Wert) - InStr(Wert, "\"))
Loop
Datei = Wert
End Function
Function Pfad(Wert As String) As String
Dim wert1$
wert1 = Wert
Do While InStr(wert1, "\") <> 0
wert1 = Right(wert1, Len(wert1) - InStr(wert1, "\"))
Loop
Pfad = Left(Wert, Len(Wert) - Len(wert1))
End Function

Answer 2

Hallo fedjo,

danke dir erst mal für deine fleißige Arbeit. Was du programmiert hast, funktioniert auch gut.

Leider aber werden die Dateinamen nur aufgelistet. Einen Dateinamen anzuklicken, um diesen in einer Variablen zu speichern, ist auf diesem Wege wohl nicht möglich. Unter Umständen müsste man die Auflistung in einer Art Auswahlfenster anzeigen lassen?

Vielleicht weißt du noch mehr. Oder sonst jemand?

Gruß
Peter

Answer 3

Hallo Peter,
kannst du das etwas genauer erklären:

Einen Dateinamen anzuklicken, um diesen in einer Variablen zu speichern

Gruß
fedjo

Answer 4

Hallo Peter,
vielleicht so:

Sub Suchen()
Dim Laufwerk$, Dateien$
z = 2
[a2:c5000] = ""
Laufwerk = "C:\Daten"
If Laufwerk = "" Then Exit Sub
Dateien = "*.xls"
Dateisuche Laufwerk, Dateien
Application.StatusBar = False
End Sub
Sub Dateisuche(Laufwerk, Dateien)
Dim tmp, Wdhlg
On Error Resume Next
If Right(Laufwerk, 1) <> "\" Then Laufwerk = Laufwerk + "\"
tmp = Dir(Laufwerk & Dateien)
Do While Len(tmp)
Cells(z, 1) = Pfad(Laufwerk & tmp)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(z, 2), Address:=Datei(Laufwerk & tmp)
z = z + 1
tmp = Dir()
Loop
tmp = Dir(Laufwerk, vbDirectory)
Do While Len(tmp)
Application.StatusBar = Laufwerk & tmp
If (tmp <> ".") And (tmp <> "..") Then
If (GetAttr(Laufwerk & tmp) And vbDirectory) = vbDirectory Then
Dateisuche Laufwerk & tmp, Dateien
z = z - 1
Wdhlg = Dir(Laufwerk, vbDirectory)
z = z + 1
Do While Wdhlg <> tmp
Wdhlg = Dir()
Loop
End If
End If
tmp = Dir()
Loop
On Error GoTo 0
Application.StatusBar = False
End Sub
Function Datei(Wert As String) As String
Do While InStr(Wert, "\") <> 0
Wert = Right(Wert, Len(Wert) - InStr(Wert, "\"))
Loop
Datei = Wert
End Function
Function Pfad(Wert As String) As String
Dim wert1$
wert1 = Wert
Do While InStr(wert1, "\") <> 0
wert1 = Right(wert1, Len(wert1) - InStr(wert1, "\"))
Loop
Pfad = Left(Wert, Len(Wert) - Len(wert1))
End Function

Gruß
fedjo

Answer 5

Hallo fedjo,

war ein paar Tage außer Gefecht und habe erst heute deinen neuen Vorschlag ausprobieren können. Hat aber leider auch nicht das gebracht, was ich brauche.

Trotzdem vielen Dank für deine Mühe.

Erläuterung: Die Dateinamen sollen in einer Auswahlbox erscheinen. Wenn ich dann einen davon anwähle, soll dieser Name in z.B. der Variablen "name" gespeichert werden, um zur weiteren Verarbeitung zur Verfügung zu stehen.

Gruß
Peter

Answer 6

Hallo fedjo
Zum Auslesen und Darstellung in Spalte A

Option Explicit

Sub DateinNamenLesen()
Dim DateiName As String
DateiName = Dir("C:\temp\" & "*.xls")
Do While DateiName <> ""
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = Mid(DateiName, 1, Len(DateiName) - 4)
DateiName = Dir
Loop
End Sub

Answer 7

Hallo

Eine Auswahlalternative

Daten/Gültigkeit/Liste

Der Bereich könnte eine ausgeblendete Spalte sein,sollte sich der Bereich auf einer anderen Tabelle befinden,so ist der bereich mit einem namen zu Definieren,der dann als listenbereich angegeben wird