Office: (Office 2013) Dateinamen aus Ordner auslesen

golochim · 10. Dezember 2017

Hallo,

ich benötige Hilfe bei folgendem Problem. Mit einem Makro :
Code:

Sub DateienAuflisten()

Dim lngZeile As Long
Dim objFileSystem As Object
Dim objVerzeichnis As Object
Dim objDateienliste As Object
Dim objDatei As Object

Set objFileSystem = CreateObject("scripting.FileSystemObject")
Set objVerzeichnis = objFileSystem.GetFolder("C:")
Set objDateienliste = objVerzeichnis.Files

lngZeile = 1

For Each objDatei In objDateienliste
If Not objDatei Is Nothing Then
ActiveSheet.Cells(lngZeile, 1) = objDatei.Name
lngZeile = lngZeile + 1
End If
Next objDatei

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

kann ich die Dateien in einem bestimmten Verzeichnis auslesen und in eine Exceltabelle schreiben. Jetzt möchte ich aber, dass der User, das Verzeichnis, in dem die Dateien stehen selbst auswählen kann. Könnte mir jemand hier Helfen, wie ich das in dem Makro schreibe??

Gruß

Jojo

:)

Jonas0806 · 11. Dezember 2017

Hallo Jojo,

z.B. so

Code:

'Herbers Excel/VBA-Beispiele
'Verzeichnisbaum aufrufen und Verzeichnis auswählen

Option Private Module

Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Sub DirAuswahl()
Dim msg As String

msg = "Wählen Sie bitte einen Ordner aus:"
MsgBox getdirectory(msg)
End Sub

Function getdirectory(Optional msg) As String
Dim bInfo As BROWSEINFO
Dim Path As String
Dim r As Long, x As Long, pos As Integer

bInfo.pidlRoot = 0&
If IsMissing(msg) Then
bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
Else
bInfo.lpszTitle = msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
Path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal Path)
If r Then
pos = InStr(Path, Chr$(0))
getdirectory = Left(Path, pos - 1)
Else
getdirectory = ""
End If
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

golochim · 11. Dezember 2017

Hallo Jonas,

vielen Dank für die Schnelle Lösung. Werde es gleich testen!

Gruß

Jojo

Beverly · 11. Dezember 2017

Hi,

hier noch eine einfache Lösungsmöglichkeit ohne API-Funktion:

Code:

Sub DateienAuflisten()
Dim strPfad As String
Dim lngZeile As Long
Dim strDatei As String
lngZeile = 1
Application.ScreenUpdating = False
strPfad = GetFolder
strDatei = Dir(strPfad & "*.*")
If strPfad "" Then
Do
Cells(lngZeile, 1) = strDatei
strDatei = Dir
lngZeile = lngZeile + 1
Loop While strDatei ""
End If
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.InitialFileName = "E:/" 'Startordner anpassen!!
.ButtonName = "OK"
.Title = "Dateiauswahl"
.Show
If .SelectedItems.Count = 0 Then
GetFolder = ""
Else
GetFolder = .SelectedItems(1)
End If
End With
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

golochim · 12. Dezember 2017

Hallo Karin,

Deine Lösung finde ich super. Vielen Dank!

Gruß

Jojo

golochim · 12. Dezember 2017

Hallo Karin,

Deine Lösung finde ich super. Vielen Dank!

Gruß

Jojo

Office: (Office 2013) Dateinamen aus Ordner auslesen

Dateinamen aus Ordner auslesen

Dateinamen aus Ordner auslesen

Dateinamen aus Ordner auslesen

Dateinamen aus Ordner auslesen - Similar Threads - Dateinamen Ordner auslesen

Name der Datei durch Excel geändert

Excel Tabellenblatt als PDF speichern unter Vorgabe Dateinamen aus einer Zelle

Dateinamen ohne Punkt und Dateiendung ermitteln

PQ: CSV-Importe aus Ordner (Dateiname in Spalte)

Ordner generieren, Dateiname aus Zelle, Speichern unter

Ordner auslesen und aktuelle Dateinamen einlesen

Import aus Ordner im Format JJJJ.MM. und Dateiname JJJJ.MM.T