Anzahl dateien aus Ordner zählen

Dieses Thema im Forum "Excel und VBA" wurde erstellt von joergi, 15 Oktober 2006.

  1. joergi

    joergi
    Expand Collapse
    New Member

    Registriert seit:
    15 Oktober 2006
    Beiträge:
    81
    Zustimmungen:
    0
    Hallo!

    Seit tagen quäle ich mich herum, wie ich die Anzahl der gespeicherten Dateien aus einem Ordner herauslesen, und in einer anderen Zelle als Zahlenwert einfügen kann. Der Grund: Die Anzahl der Dateien wird benötigt, um eine eindeutige durchgehende nummer zu erhalten. Ich habe unten das womit ich aufgehört habe einfach mal reinkopiert. (das ist noch mit MSG BOX und funktioniert auch in keinster weise.)


    sub Anzahl dateien

    Dim Dateiform As String
    Dim Suchpfad As String
    Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", Application.DefaultFilePath)
    If Suchpfad = "" Then Exit Sub
    Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.xls")
    If Dateiform = "" Then Exit Sub
    With Application.FileSearch
    .LookIn = Suchpfad ' Suchverzeichnis
    .SearchSubFolders = False ' suchen im Unterverzeichnis
    .Filename = Dateiform
    MsgBox .Execute()
    End With
    'End Sub
     
  2. Pitter

    Pitter
    Expand Collapse
    <font color="#FF0000">CO-*****</font><br><img src=

    Registriert seit:
    13 August 2001
    Beiträge:
    2.562
    Zustimmungen:
    0
    Hallo Joergi,

    bitte auch mal die Suchfunktion bemühen... Habe den Beitrag mal ins richtige Forum verschoben...
     
  3. Schmitti

    Schmitti
    Expand Collapse
    <font color="#FF0000">S-Moderator</font><br><img s

    Registriert seit:
    17 Februar 2001
    Beiträge:
    3.953
    Zustimmungen:
    0
    Habe hier mal was rausgekramt:

    Code:
    Private Const MAX_PATH As Long = 260
    Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
    Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
    Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
    Private Const FILE_ATTRIBUTE_HIDDEN = &H2
    Private Const FILE_ATTRIBUTE_NORMAL = &H80
    Private Const FILE_ATTRIBUTE_READONLY = &H1
    Private Const FILE_ATTRIBUTE_SYSTEM = &H4
    Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
    
    Dim Anzahl
    
    Type FileTime
        dwLowDateTime As Long
        dwHighDateTime As Long
    End Type
    
    Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FileTime
        ftLastAccessTime As FileTime
        ftLastWriteTime As FileTime
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
    End Type
    
    Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
    Private Declare Function SearchPath Lib "kernel32" Alias "SearchPathA" (ByVal lpPath As String, ByVal lpFileName As String, ByVal lpExtension As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long
    
    Private Function FindFile(ByVal FileName As String, ByVal Path As String) As String
        Dim hFile As Long, ts As String, WFD As WIN32_FIND_DATA
        Dim result As Long, sAttempt As String, szPath As String
        szPath = AddSlash(Path) & "*.*" & Chr$(0)
        Dim szPath2 As String, szFilename As String, dwBufferLen As Long, szBuffer As String, lpFilePart As String
        szPath2 = Path & Chr$(0)
        szFilename = FileName & Chr$(0)
        szBuffer = String$(MAX_PATH, 0)
        dwBufferLen = Len(szBuffer)
        result = SearchPath(szPath2, szFilename, vbNullString, dwBufferLen, szBuffer, lpFilePart)
        If result Then
            FindFile = StripNull(szBuffer)
            Exit Function
        End If
        hFile = FindFirstFile(szPath, WFD)
        Do
            If WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
                ts = StripNull(WFD.cFileName)
                If Not (ts = "." Or ts = "..") Then
                    If Not (WFD.dwFileAttributes And (FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_SYSTEM)) Then
                        OrdnerAnzahl = OrdnerAnzahl + 1
                        sAttempt = FindFile(FileName, AddSlash(Path) & ts)
                        If sAttempt <> "" Then
                            FindFile = sAttempt
                            Exit Do
                        End If
                    End If
                End If
            Else
                Pfad = AddSlash(Path)
                Dateiname = StripNull(WFD.cFileName)
                Anzahl = Anzahl + 1
                'SetAttr Path & "\" & Dateiname, vbArchive
            End If
            WFD.cFileName = ""
            result = FindNextFile(hFile, WFD)
        Loop Until result = 0
        FindClose hFile
        Exit Function
    err:
    End Function
    
    'Leerzeichen entfernen
    Private Function StripNull(ByVal WhatStr As String) As String
        Dim pos As Integer
        pos = InStr(WhatStr, Chr$(0))
        If pos > 0 Then
            StripNull = Left$(WhatStr, pos - 1)
        Else
            StripNull = WhatStr
        End If
    End Function
    
    'ggf. Backslash anhängen
    Private Function AddSlash(ByVal sPath As String) As String
        If sPath = "" Then Exit Function
        If Right$(sPath, 1) = "\" Then AddSlash = sPath: Exit Function
        AddSlash = sPath & "\"
    End Function
    
    Public Sub START()
        Anzahl = 0
        FindFile "*.*", "c:\temp"
        MsgBox Anzahl
    End Sub
    
     
  4. RO_SCH

    RO_SCH
    Expand Collapse
    Moderator

    Registriert seit:
    27 August 2006
    Beiträge:
    2.446
    Zustimmungen:
    14
    Hi joergi,

    Schmitti hat natürlich absolut recht.

    Wenn du aber einfach nur Dateien zählen willst die weder komprimiert noch versteckt noch Systemdateien und auch keine temporären Dateien sind, dann brauchst du einfach nur sowas:
    PHP:
    Sub Dateien_zählen()
    Dim DateiZahl As StringAs Integer
      i 
    1
      DateiZahl 
    Dir$("c:\*.*"'Hier Verzeichnis und Datei Suchmuster angeben
      Do While DateiZahl <> ""
      If Not IsEmpty(DateiZahl) Then
      Cells(1, 2) = i
      '
    ActiveCell.Offset(i0) = DateiZahl 'zeigt Dateien ab der aktiven Zelle an - wers braucht
      i = i + 1
      DateiZahl = Dir$()
      End If
      Loop
    End Sub
    Gruß Roland
     
    #4 RO_SCH, 17 Oktober 2006
    Zuletzt bearbeitet: 17 Oktober 2006
  5. bst

    bst
    Expand Collapse
    <font color="#FF0000">Excel Moderator</font><br><i

    Registriert seit:
    26 Oktober 2004
    Beiträge:
    3.063
    Zustimmungen:
    1
    Hallo zusammen,

    oder auch einfach nur sowas.

    cu, Bernd
    --
    Code:
    Option Explicit
    
    Sub x()
       Dim fso As Object
       
       Set fso = CreateObject("Scripting.FileSystemObject")
       MsgBox fso.GetFolder("D:\test").Files.Count
       Set fso = Nothing
    End Sub
     
  6. joergi

    joergi
    Expand Collapse
    New Member

    Registriert seit:
    15 Oktober 2006
    Beiträge:
    81
    Zustimmungen:
    0
    Hallo Bernd, das funzt genial, ist außerdem fantastisch kurz. Bin absolut begeistert!
    kannst du noch eine Alternative zur MSG BOX machen (besser wäre es wenn es im active sheet in Zelle a20 eingtragen würde. Ich habs versucht, aber es will nicht!

    Danke Danke Danke Danke Danke Danke Danke Danke Danke Danke Danke Da
     
  7. bst

    bst
    Expand Collapse
    <font color="#FF0000">Excel Moderator</font><br><i

    Registriert seit:
    26 Oktober 2004
    Beiträge:
    3.063
    Zustimmungen:
    1
    Morgen joergi,

    Code:
    Option Explicit
    
    Sub x()
       Dim fso As Object
       
       Set fso = CreateObject("Scripting.FileSystemObject")
       ActiveSheet.Range("A20") = fso.GetFolder("E:\test").Files.Count
       Set fso = Nothing
    End Sub
    
    
    cu, Bernd
     
  8. joergi

    joergi
    Expand Collapse
    New Member

    Registriert seit:
    15 Oktober 2006
    Beiträge:
    81
    Zustimmungen:
    0
    Moin Bernd-
    ich hatte das mit value versucht. Aber deine idee funktioniert deutlich besser.

    wie vorhin schon gesagt- Einfach kurz und gut
     
  9. rks1

    rks1
    Expand Collapse
    New Member

    Registriert seit:
    3 August 2012
    Beiträge:
    1
    Zustimmungen:
    0
    Hallo!!

    Ein sehr interessantes Thema. Gibt es auch eine Möglichkeit, nur die Dateien mit einer bestimmten Endung zu zählen?
     
  10. bst

    bst
    Expand Collapse
    <font color="#FF0000">Excel Moderator</font><br><i

    Registriert seit:
    26 Oktober 2004
    Beiträge:
    3.063
    Zustimmungen:
    1
    Hi,

    nein. Du musst schon selber zählen.

    cu, Bernd
    --
    Code:
    Option Explicit
    
    Sub x()
       Dim fso As Object, objFile As Object, intCount As Integer
       
       Set fso = CreateObject("Scripting.FileSystemObject")
       For Each objFile In fso.GetFolder("E:\test").Files
          If LCase(Right(objFile.Name, 4)) = ".txt" Then intCount = intCount + 1
       Next
       Set fso = Nothing
       MsgBox intCount
    End Sub
     
Die Seite wird geladen...

Diese Seite empfehlen