Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Alle Dateien in einen Ordner

Alle Dateien in einen Ordner
29.10.2017 18:08:27
Bernd
Hallo liebe Excel-Freunde,
Ich möchte alle Dateien im Ordner "Beispiel", auch Dateien in jedem Unterordner von "Beispiel", in den Ordner "Hierher" kopieren.
Kann mir da bitte jemand einen Code geben.
Vielen lieben Dank und einen schönen Sonntag Abend noch
Gruß Bernd

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Robocopy
29.10.2017 18:13:01
Fennek
Hallo,
für ein einmaliges Kopieren sollte "Robocopy" mit dem Schalter "/s" ideal sein.
Also ein CMD-Fenster öffnen ....
mfg
Syntax mit Robocopy /?
AW: Robocopy
29.10.2017 18:23:47
Bernd
Hallo Robocopy,
danke für Deine Antwort, aber leider habe ich davon Null Ahnung.
AW: Robocopy
29.10.2017 19:25:35
Nepumuk
Hallo Bernd,
teste mal:
Option Explicit

Public Sub test()
    
    Const SOURCE_PATH As String = "H:\Beispiel\"
    Const TARGET_PATH As String = "H:\Hierher\"
    
    Dim astrFolders() As String, strFile As String
    Dim ialngIndex As Long
    
    astrFolders = GetFolders(SOURCE_PATH)
    
    For ialngIndex = LBound(astrFolders) To UBound(astrFolders)
        
        strFile = Dir$(astrFolders(ialngIndex) & "*.*")
        
        Do Until strFile = vbNullString
            
            FileCopy astrFolders(ialngIndex) & strFile, TARGET_PATH & strFile
            
            strFile = Dir$
            
        Loop
        
    Next
End Sub

Private Function GetFolders(ByVal pvstrPath As String) As String()
    
    Dim astrFolders() As String
    Dim strFolder As String, strPath As String
    Dim ialngIndex1 As Long, ialngIndex2 As Long
    
    strPath = pvstrPath
    
    Do
        
        strFolder = Dir$(strPath & "*", vbDirectory)
        
        Do Until strFolder = vbNullString
            
            If strFolder <> "." And strFolder <> ".." Then
                
                If GetAttr(strPath & strFolder) And vbDirectory Then
                    
                    Redim Preserve astrFolders(0 To ialngIndex1)
                    
                    astrFolders(ialngIndex1) = strPath & strFolder & "\"
                    
                    ialngIndex1 = ialngIndex1 + 1
                    
                End If
            End If
            
            strFolder = Dir$
            
        Loop
        
        If ialngIndex1 = ialngIndex2 Then Exit Do
        
        strPath = astrFolders(ialngIndex2)
        
        ialngIndex2 = ialngIndex2 + 1
        
    Loop
    
    GetFolders = astrFolders
    
End Function

Gruß
Nepumuk
Anzeige
AW: Robocopy
29.10.2017 19:46:02
Bernd
Hallo Nepumuk,
vielen Dank, aber da kommt die Fehlermeldung:
Fehler beim Kompilieren
Sub oder Function nicht definiert
Gruß Bernd
Code funktioniert einwandfrei! o.T.
29.10.2017 19:55:12
Sepp
Gruß Sepp

AW: Code funktioniert einwandfrei! o.T.
29.10.2017 20:04:06
Bernd
Hmm?
was habe ich denn falsch gemacht?
Ich habe den Code so kopiert und in ein Modul eingefügt.
AW: Code funktioniert einwandfrei! o.T.
29.10.2017 20:11:06
Sepp
Hallo Bernd,
wie Nepumuk schon vermutet hat, hast du wohl nicht den gesamten Code kopiert.
Gruß Sepp

Anzeige
AW: Robocopy
29.10.2017 20:00:42
Nepumuk
Hallo Bernd,
dann musst du einen Fehler beim kopieren gemacht haben. Ich habe den Code natürlich getestet und da kam keine Fehlermeldung.
Gruß
Nepumuk
AW: Robocopy
29.10.2017 20:31:29
Bernd
Hallo Nepumuk,
ich muss nochmal blöd nachfragen.
Wo muss ich den Code denn speichern?
Danke Nepumuk, jetzt funktioniert es o.w.t.
29.10.2017 20:53:20
Bernd
.

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige