Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
964to968
964to968
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Dateien aus Verzeichnis einlesen

Forumthread: Dateien aus Verzeichnis einlesen

Dateien aus Verzeichnis einlesen
05.04.2008 00:39:00
Michael
Hallo zusammen,
ich würde gerne die Dateien aus einem Verzeichnis ohne Pfad und ohne Dateiendung nach Excel einlesen.
Gruß M.S.

Anzeige

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateien aus Verzeichnis einlesen
05.04.2008 00:50:14
Wolli
Moin Michael, mit diesem Makro (Pfad im Code anpassen!) gelingt es.

Sub Dateien_lesen()
Dim strPfad As String, _
strDatei As String
strPfad = "C:\NVIDIA\Win2KXP\93.71\"
strDatei = Dir(strPfad)
Do While strDatei  ""
ActiveCell = Left(strDatei, InStrRev(strDatei, ".") - 1)
ActiveCell.Offset(1, 0).Select
strDatei = Dir
Loop
End Sub


Gruß, Wolli

Anzeige
AW: Dateien aus Verzeichnis einlesen
05.04.2008 00:56:00
Tino
Hallo,
da müsstest du schon ein bar Infos mehr geben!
Was für Dateien sind es Text, Excel?
Wo sollen die Daten hin? Untereinander oder jede Datei in ein eigenes Tabellenblatt
Ist der Ordner Fest oder kann er Variieren?
Müssen Unterverzeichnisse mit eingelesen werden?
Warum habe die Dateien keine Endung?
Habe ich noch was vergessen, dass zur Lösung beitragen könnte?
Gruß
Tino

Anzeige
AW: Dateien aus Verzeichnis einlesen
05.04.2008 18:12:05
Michael
Hallo Tino,
es handelt sich um tiff & pdf Dateien.
Der Ordner soll variabel sein - die Exceldatei liegt im Ordner A welcher Unterverzeichnisse AA, AB und AC hat.
Die Daten sollen untereinander in ein Tabellenblatt geschrieben, wobei jedes Unterverzeichnis ein Tabellenblatt sein soll.
Gruß M.S.

Anzeige
AW: Dateien aus Verzeichnis einlesen
06.04.2008 17:28:00
Tino
Hallo,
tiff Dateien?
Ist doch ein Dateiformat zur Speicherung von Bilddaten, was für Daten sollen da ausgelesen werden?
Du musst schon etwas genauer!
Gruß
Tino

AW: Dateien aus Verzeichnis einlesen
07.04.2008 06:29:00
Michael
den Dateiname vielleicht!

AW: Dateien aus Verzeichnis einlesen
07.04.2008 08:40:00
Tino
Hallo,
sorry da hab ich dich falsch verstanden, Lösungsansetze sind ja schon eingegangen.
Gruß
Tino

Anzeige
AW: Dateien aus Verzeichnis einlesen
06.04.2008 19:08:14
Josef
Hallo Michael,
probier mal.
' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub ListFiles()
Dim a
Dim result As Long, l As Long
Dim strPath As String, strName As String
Dim objWS As Worksheet
strPath = fncBrowseForFolder
If strPath <> "" Then
    result = FileSearchINFO(a, strPath, SubFolders:=True)
    
    If result <> 0 Then
        For l = 0 To UBound(a)
            strName = a(l).ParentFolder.Name
            strName = SetSheetName(strName)
            If Not SheetExist(strName) Then
                Set objWS = Worksheets.Add(after:=Sheets(Sheets.Count))
                objWS.Name = strName
            Else
                Set objWS = Sheets(strName)
            End If
            objWS.Cells(objWS.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = a(l).Name
        Next
    End If
End If
End Sub

'by J.Ehrensberger
Private Function FileSearchINFO(ByRef Files As Variant, ByVal InitialPath As String, Optional ByVal FileName As String = "*", _
    Optional ByVal SubFolders As Boolean = False) As Long

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

Set fobjFSO = CreateObject("Scripting.FileSystemObject")

Set ffsoFolder = fobjFSO.GetFolder(InitialPath)

On Error Resume Next

For Each ffsoFile In ffsoFolder.Files
    If Not ffsoFile Is Nothing Then
        If LCase(fobjFSO.GetFileName(ffsoFile)) Like LCase(FileName) Then
            If IsArray(Files) Then
                Redim Preserve Files(UBound(Files) + 1)
            Else
                Redim Files(0)
            End If
            Set Files(UBound(Files)) = ffsoFile
        End If
    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
On Error GoTo 0
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

Private Function SheetExist(ByVal sheetName As String, Optional WbName As String) As Boolean
Dim wks As Worksheet
On Error GoTo ERRORHANDLER
If WbName = "" Then WbName = ThisWorkbook.Name
For Each wks In Workbooks(WbName).Worksheets
    If wks.Name = sheetName Then SheetExist = True: Exit Function
Next
ERRORHANDLER:
SheetExist = False
End Function

Private Function SetSheetName(newName As String) As String
Dim badSign As String
Dim notAllowed As Variant
Dim n As Integer

notAllowed = Array(":", "\", "/", "?", "*", "[", "]")

For n = 0 To UBound(notAllowed)
    newName = Replace(newName, notAllowed(n), "")
Next

newName = Left(newName, 31)

SetSheetName = newName

End Function


Gruß Sepp



Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige