Office: (Office 2010) Ordner auslesen Pfad + Datei als hyperlink

OfficeUser · 9. März 2013

Hallo zusammen,

ich möchte in der Tabelle "Dateilisten" über einen Button Ordner einlesen, siehe Beispiel ...

Dateilisten
A B C D
1
2 Dateipfad Dateiname Dateigröße Datum/Zeit
3 D:\Firma\Angebote13 9001.11.03.2013.pdf 17 KB 11.03.2013 18:07
4 9002.05.03.2013.pdf 17 KB 05.03.2013 10:23
5
6 D:\Firma\Listen Angebotsliste.xls 63 KB 11.03.2013 17:42
7 Kundenliste.xls 82 KB 11.03.2013 17:46
8 Rechnungsliste.xls 50 KB 11.03.2013 17:42
9
10 D:\Firma\Rechnungen13 9006.2013-03.00042.pdf 137 KB 11.03.2013 18:07
definierte Namen
Name Bezieht sich auf Tabelle Z1S1-Formel
Print_Area =Dateilisten!$A:$C9 Dateilisten =Dateilisten!Z2S1:Z199S3
:)

Hajo_Zi · 11. März 2013

Hallo Bernd,

Ordner auslesen

Bernd Kiehl · 11. März 2013

Hallo Hajo,

Danke für deine schnelle Antwort. Deine Datei kenne ich, für mich als Laie stellt sich die Frage: Wie kann ich deine Datei/Makros in meine Tabelle einbauen bzw. meiner Schaltfläche zuweisen????

Kannst du mir da weiterhelfen???

Gruß Bernd

Hajo_Zi · 11. März 2013

ich hätte angenommen meine Datei macht genau das was Du willst ohne Anpassung. Da habe ich mich wohl geirrt.

Bernd Kiehl · 11. März 2013

Hallo Hajo,

Du hast Recht deine Datei macht genau das, was ich auch will!!!

Meine Frage ist, wie kann ich deine Datei in mein Workbook integrieren???

Bernd Kiehl · 12. März 2013

Hallo Josef,
hallo alle zusammen,

nachfolgenden Code hier aus dem Forum von Josef habe ich etwas angepasst, aber etwas fehlt noch und ich komme nicht weiter.

Meine Wunsch wäre es, den Code so zu verändern, dass die "Inputbox" wegfällt und ich Pfad "D:\Firma" und Dateiformat "*.*" vorgebe. Alles soll durch klick auf einen Button ausgelöst werden.

Wer, außer Josef, kann helfen???

Hier der von mir bereits angepasste Code:

Sub ordner_einlesen()

Dim objFiles() As Object, lngRet As Long, lngIndex As Long, lngRow As Long

Dim strPath As String, strFile As String

strPath = fncBrowseForFolder

If strPath <> "" Then

strFile = InputBox("Dateinamensteileingeben :" & Chr(13) & "z.B. Eingabe_*.*")

If strFile <> "" Then

lngRet = FileSearchINFO(objFiles, strPath, strFile, True)

If lngRet > 0 Then

lngRow = Cells(Rows.Count, 1).End(xlUp).Row + 1

For lngIndex = 0 To lngRet - 1

Cells(lngRow + lngIndex, 1) = objFiles(lngIndex).ParentFolder.Path

Cells(lngRow + lngIndex, 2) = objFiles(lngIndex).Name

Cells(lngRow + lngIndex, 3) = objFiles(lngIndex).Size

Cells(lngRow + lngIndex, 4) = objFiles(lngIndex).DateLastModified

Next

End If

End If

End If

End Sub

Private Function FileSearchINFO(ByRef Files() As Object, ByVal InitialPath As String, Optional ByVal FileName As String = "*", _

Optional ByVal SubFolders As Boolean = False) As Long

'# PARAMETERINFO:

'# Files: Datenfeld zur Ausgabe der Suchergebnisse

'# InitialPath: String der das zu durchsuchende Verzeichnis angibt

'# FileName: String der den gesuchten Dateityp oder Dateinamen enthält (Optional, Standard="*.*" findet alle Dateien)

'# Beispiele: "*.txt" - Findet alle Textdateien

'# "*name*" - Findet alle Dateien mit "name" im Dateinamen

'# "*.avi;*.mpg" - Findet .avi und .mpg Dateien (Dateitypen mit ; trennen)

'# SubFolders: Boolean gibt an, ob Unterordner durchsucht werden sollen (Optional, Standard=False)

Dim fobjFSO As Object, ffsoFolder As Object, ffsoSubFolder As Object, ffsoFile As Object

Dim intC As Integer, varFiles As Variant

Set fobjFSO = CreateObject("Scripting.FileSystemObject")

Set ffsoFolder = fobjFSO.GetFolder(InitialPath)

On Error GoTo ErrExit

If InStr(1, FileName, ";") > 0 Then

varFiles = Split(FileName, ";")

Else

Redim varFiles(0)

varFiles(0) = FileName

End If

For Each ffsoFile In ffsoFolder.Files

If Not ffsoFile Is Nothing Then

For intC = 0 To Ubound(varFiles)

If LCase(fobjFSO.GetFileName(ffsoFile)) Like LCase(varFiles(intC)) Then

If IsArray(Files) Then

Redim Preserve Files(Ubound(Files) + 1)

Else

Redim Files(0)

End If

Set Files(Ubound(Files)) = ffsoFile

Exit For

End If

Next

End If

Next

If SubFolders Then

For Each ffsoSubFolder In ffsoFolder.SubFolders

FileSearchINFO Files, ffsoSubFolder, FileName, SubFolders

Next

End If

If IsArray(Files) Then FileSearchINFO = Ubound(Files) + 1

ErrExit:

Set fobjFSO = Nothing

Set ffsoFolder = Nothing

End Function

Private Function fncBrowseForFolder(Optional ByVal defaultPath = "") As String

Dim objFlderItem As Object, objShell As Object, objFlder As Object

Set objShell = CreateObject("Shell.Application")

Set objFlder = objShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, defaultPath)

If objFlder Is Nothing Then GoTo ErrExit

Set objFlderItem = objFlder.Self

fncBrowseForFolder = objFlderItem.Path

ErrExit:

Set objShell = Nothing

Set objFlder = Nothing

Set objFlderItem = Nothing

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

Gopher-TM- · 10. Januar 2020

Hallo Hajo,

genau das was ich gesucht habe. Danke sehr ! Allerdings krieg ich die Userform nicht in meinem Projekt zum laufen, es kommt ein Fehler: Fehler beim Kompilieren - Benutzerdefinierter Typ nicht definiert.

Was mache ich falsch ?

Wie gesagt, das Projekt läuft Fehlerfrei mit meinem Excel. Nur wenn ich die Tabelle mitsamt Userform und Modul in mein Projekt kopiere kommt die Fehlermeldung.

Danke & Gruß, Magnus

Office: (Office 2010) Ordner auslesen Pfad + Datei als hyperlink

Ordner auslesen Pfad + Datei als hyperlink

Ordner auslesen Pfad + Datei als hyperlink

Ordner auslesen Pfad + Datei als hyperlink

Ordner auslesen Pfad + Datei als hyperlink - Similar Threads - Ordner auslesen Pfad

Sharepoint Ordner auslesen

Ordner und Unterordner auslesen mit Anzahl der Unterordner/Dateien pro Ordner

Ordner auslesen

Ordner auslesen auf Excel

Dateinamen aus Ordner auslesen

Desktoppfad auslesen und Ordner anlegen (wenn nicht vorhanden)

Ordner mit Rechnungsnr. auslesen und nächste verwenden

	A	B	C	D
1
2	Dateipfad	Dateiname	Dateigröße	Datum/Zeit
3	D:\Firma\Angebote13	9001.11.03.2013.pdf	17 KB	11.03.2013 18:07
4		9002.05.03.2013.pdf	17 KB	05.03.2013 10:23
5
6	D:\Firma\Listen	Angebotsliste.xls	63 KB	11.03.2013 17:42
7		Kundenliste.xls	82 KB	11.03.2013 17:46
8		Rechnungsliste.xls	50 KB	11.03.2013 17:42
9
10	D:\Firma\Rechnungen13	9006.2013-03.00042.pdf	137 KB	11.03.2013 18:07

definierte Namen
Name	Bezieht sich auf	Tabelle	Z1S1-Formel
Print_Area	=Dateilisten!$A:$C9	Dateilisten	=Dateilisten!Z2S1:Z199S3