Ausgewählter Dateipfad in Zelle
20.07.2016 15:53:10
Hendrik
ich bräuchte nochmal Eure Hilfe...
Ich habe folgenden VBA-Code, der Dateinamen, die in einem Ordner stehen (den Ordner wähle ich selbst durch die Funktion aus), in Zelle A1 bis A100 schreibt.
Nun soll aber der gesamte Dateipfad des zuvor ausgewählten Ordner in Zelle C1 bis C100 geschrieben werden.
Frage: Was muss ich hinzufügen, um den Dateipfad des ausgewählten Ordner in Zelle C1:C100 stehen zu haben ?
Hier der Code:
Sub Datenauslesen()
'Dateinamen in einem bestimmten Verzeichnis auflisten
Dim Dateiname As String, i As Integer
Dim Pfad As String
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Lieferanten")
Msgbox "Öffnen Sie bitte den Ordner."
ws.Range("A2:B500").ClearContents
'Funktion GetPath aufrufen um Pfadname zu ermitteln
Pfad = GetPath()
' Wenn kein Ordner ausgewählt wird, hier Ende
If Pfad = "" Then Exit Sub
Dateiname = Dir$(Pfad & "\*.*")
' Wenn kein Ordner keine Dateien enthält, hier Ende
If Dateiname = "" Then Exit Sub
Do While Dateiname ""
ws.Cells(2, 1).Offset(i, 0) = Dateiname
i = i + 1
Dateiname = Dir$()
Loop
Msgbox i & " Dateien im Ordner ''" & Pfad & "'' registriert!"
End Sub
Private Function GetPath() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
' Voreingestellter Pfad, ggf. ändern
.InitialFileName = "S:\SNEID012\Meine\" 'Ab hier ist der Dateipfad variabel.
.Title = "Ordnerauswahl"
.InitialView = msoFileDialogViewDetails
.ButtonName = "Ordner wählen"
.Title = "Ordner auswählen"
.Show
If .SelectedItems.Count = 0 Then
GetPath = ""
Else
GetPath = .SelectedItems(1)
End If
End With
End Function
Viele Grüße
Hendrik