Thema Datum  Von Nutzer Rating
Antwort
15.05.2012 14:39:22 Dennis
NotSolved
Blau Dateien Kopieren aus zwei SubOrdnern
15.05.2012 18:48:55 Till
NotSolved

Ansicht des Beitrags:
Von:
Till
Datum:
15.05.2012 18:48:55
Views:
859
Rating: Antwort:
  Ja
Thema:
Dateien Kopieren aus zwei SubOrdnern

Hi,

hier eine Funktion, die dir eine Liste zurückgibt, welche alle Files in einer Struktur enthält:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
Private Sub TestAufruf()
Dim List$()
Dim a&, E&
Dim Ret
 
    'get files
    Ret = getFiles(List, "C:\", True)
     
    'error?
    Select Case Ret
    Case False
        MsgBox "Unexpected exception.", vbCritical
        Exit Sub
    Case True
    Case Else
        MsgBox Ret, vbCritical
        Exit Sub
    End Select
     
    'display data
    E = UBound(List)
    For a = 0 To E
        Debug.Print List(a)
    Next
    MsgBox E + 1 & " files gefunden."
     
End Sub
Function getFiles( _
List$(), ByVal Path$, _
Optional ByVal Subfolders As Boolean = False, _
Optional ByVal FilenameFilter$ = "*", _
Optional ByVal ExtensionFilter$ = "*" _
) As Variant
     
    'check for errors
        If Dir(Path) = "" Then
            getFiles = "Folder doesn't exist"
            Exit Function
        End If
    'start search
        getFiles = ListFiles(List, Path, Subfolders, FilenameFilter, ExtensionFilter)
         
End Function
 
Private Function ListFiles(List$(), ByVal Path$, ByVal Subfolders As Boolean, ByVal FilenameFilter$, ByVal ExtensionFilter$, _
Optional ByRef a& = -1) As Boolean
Dim oFS As Object, OFolder As Object, oSubfolder As Object, OFile As Object
Dim E&, b&, tmp$
On Error GoTo FileListingFailed
 
    'set
        Set oFS = CreateObject("Scripting.FileSystemObject")
        Set OFolder = oFS.GetFolder(Path)
 
    'search
        'subfolders
            If Subfolders Then
                For Each oSubfolder In OFolder.Subfolders
                    ListFiles List, oSubfolder.Path, Subfolders, FilenameFilter, ExtensionFilter, a
                Next
            End If
                 
        'folder
            E = OFolder.FILES.Count
            If E = 0 Then Exit Function
            ReDim Preserve List(a + E)
             
            tmp = Dir(Path & "\" & FilenameFilter & "*" & ExtensionFilter)
            While tmp <> ""
                a = a + 1
                List(a) = Path & "\" & tmp
                tmp = Dir
            Wend
            ReDim Preserve List(a)
             
ListFiles = True
FileListingFailed:
    'reset
        Set OFolder = Nothing
        Set oFS = Nothing
        Set oSubfolder = Nothing
        Set OFile = Nothing
 
End Function

 

Ansonsten kannst du auch nach einfach nach rekursiven Methoden für Dateiauflistungen suchen, oder dir diesen Thread anschauen:

http://www.vba-forum.de/Forum/View.aspx?ziel=12330-Unterordner_durchsuchen_+_Datei_Import

 

Gruß

Till


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
15.05.2012 14:39:22 Dennis
NotSolved
Blau Dateien Kopieren aus zwei SubOrdnern
15.05.2012 18:48:55 Till
NotSolved