Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Sicherheitshinweis ---> für registrierte Mitglieder <-
VBA - Dateien aus mehreren Unterverzeichnissen kopieren
zurück: Excel Speicher-Makro weiter: Probleme mit Auswahl eines Listboxen-Eintrages mit Excel-VBA Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Offen Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
Excel-VBA-Neuling
Im Profil kannst Du frei den Rang ändern


Verfasst am:
28. März 2012, 17:58
Rufname:

VBA - Dateien aus mehreren Unterverzeichnissen kopieren - VBA - Dateien aus mehreren Unterverzeichnissen kopieren

Nach oben
       Version: Office 2007

Hallo Gemeinde,

ich versuche mich an VBA-Makros... Da ich Neuling bin, habt bitte Verständnis, wenn ich mal Nachfragen hätte...

Problemstellung:
Folgende Ordnerstruktur:

C:\TEST\OrdnerA\DateiA.txt
C:\TEST\OrdnerA\DateiB.txt
C:\TEST\OrdnerA\ADatei.txt
C:\TEST\OrdnerA\BDatei.txt

C:\TEST\OrdnerB\DateiA.txt
C:\TEST\OrdnerB\DateiB.txt
C:\TEST\OrdnerB\ADatei.txt
C:\TEST\OrdnerB\BDatei.txt

uns so weiter... viele Ordner mit vielen Dateien...

Nun soll das VBA-Skript folgendes erledigen...

- Ich gebe das Stammverzeichnis an (C:\TEST\)
- Suchmaske z.B. A*.txt oder *.txt oder Datei*.txt
- VBA geht alle Unterordner durch und kopiert die Dateien lt. Suchmaske in einen vorher definierten Ordner... z.B. C:\Suchergebnis)

- Sollte beim Kopiervorgang festgestellt werden, dass eine Datei in C:\SUCHERGEBNIS bereits vorhanden ist, dann soll er die Zahl 2 anhängen und so hochzählen.. z.B. DateiA.txt ist schon vorhanden, dann nicht überschreiben sondern DateiA2.txt, DateiA3.txt usw...


Ich hoffe, dass mein Anliegen verständlich rüber kam... und DANKE DANKE DANKE für alle Lösungsvorschläge Smile

LG

Manni Smile
Excel-VBA-Neuling
Im Profil kannst Du frei den Rang ändern


Verfasst am:
28. März 2012, 18:23
Rufname:


AW: VBA - Dateien aus mehreren Unterverzeichnissen kopieren - AW: VBA - Dateien aus mehreren Unterverzeichnissen kopieren

Nach oben
       Version: Office 2007

Vielleicht hätte ich einen Lösungsansatz... und jemand könnte Ihn perfektionieren...

Das Problem dabei:
Er kopiert die Dateien perfekt.. aber nur dann, wenn sie eine Endung haben. Also z.B. DateiA.txt... wenn kein Suffix/Endung vorhanden ist, dann funktioniert es nicht mehr z.B. bei DateiA (ohne .txt) funktioniert es nicht mehr Sad

In der Suchmaske steht: "."

aber auch wenn ich mit "" oder "*" probiere, funktioniert es nicht Sad

Was muss ich denn stattdessen in dieser Suchmaske angeben???
Hat jemand eine Idee???


Code:

Sub Kopieren()
Dim arr() As String
ind = 0
ReDim Preserve arr(ind)
ziel = "C:\TEST2\" 'bitte abschliessendes \ eingeben
arr(ind) = "C:\TEST\" 'bitte abschliessendes \ eingeben
Do While ind <= UBound(arr())
d = Dir(arr(ind), vbDirectory)
Do While d <> ""
If d <> "." And d <> ".." Then
If (GetAttr(arr(ind) & d) And vbDirectory) > 0 Then
ReDim Preserve arr(UBound(arr()) + 1)
arr(UBound(arr())) = arr(ind) & d & "\"
End If
If InStr(1, UCase(d), ".") > 0 Then
FileCopy arr(ind) & d, ziel & d
End If
End If
d = Dir
Loop
ind = ind + 1
Loop
End Sub
rogstar
learning by doing


Verfasst am:
30. März 2012, 14:16
Rufname:
Wohnort: _Hessen_

AW: VBA - Dateien aus mehreren Unterverzeichnissen kopieren - AW: VBA - Dateien aus mehreren Unterverzeichnissen kopieren

Nach oben
       Version: Office 2007

Hallo,
versuch es mal so
Code:
Sub test()
    Dim strSuchmaske$
    strSuchmaske = InputBox("Wonach soll gesucht werden?")
    ListSubfolder "D:\Test", strSuchmaske
End Sub

Sub ListSubfolder(strFolder, strFind$)
    Dim SourceFolder As Object, SubFolder As Object, strFilename$, strFilenameOld$, i&
    Const strZielordner$ = "D:\Suchergebnis\"
    Set SourceFolder = CreateObject("Scripting.FileSystemObject").GetFolder(strFolder)
    For Each SubFolder In SourceFolder.SubFolders
        strFilename = Dir(SubFolder & "\" & strFind, vbNormal)
        Do Until Len(strFilename) = 0
            i = 1
            strFilenameOld = strFilename
            Do Until Not CreateObject("Scripting.FileSystemObject").FileExists(strZielordner & strFilename)
                i = i + 1
                strFilename = Left(strFilenameOld, InStrRev(strFilenameOld, ".") - 1) & i & Right(strFilenameOld, Len(strFilenameOld) - InStrRev(strFilenameOld, ".") + 1)
            Loop
            FileCopy SubFolder & "\" & strFilenameOld, strZielordner & strFilename
            strFilename = Dir$
        Loop
        Call ListSubfolder(SubFolder, strFind)
    Next SubFolder
End Sub

_________________
Gruß, Tobias
Excel-VBA-Neuling
Im Profil kannst Du frei den Rang ändern


Verfasst am:
06. Apr 2012, 17:22
Rufname:

AW: VBA - Dateien aus mehreren Unterverzeichnissen kopieren - AW: VBA - Dateien aus mehreren Unterverzeichnissen kopieren

Nach oben
       Version: Office 2007

OMG Tobias...

das ich der absolute Hammer... Very Happy

Vielen Dank... Damit hast Du mir sehr weitergeholfen Smile

DANKE DANKE DANKE Smile))

Grüße

M. Smile))
Excel-VBA-Neuling
Im Profil kannst Du frei den Rang ändern


Verfasst am:
26. Apr 2012, 10:23
Rufname:

AW: VBA - Dateien aus mehreren Unterverzeichnissen kopieren - AW: VBA - Dateien aus mehreren Unterverzeichnissen kopieren

Nach oben
       Version: Office 2007

Hallo Tobias,

Du hast mir bei diesem Problem schon mal geholfen.. nun habe ich eine minimale Anpassung, die ich alleine nicht hinbekomme... Sad Könntest Du mir helfen?

Dein Code funktioniert PERFEKT:

Code:
Sub DATEI_KOPIEREN()
    Dim strSuchmaske$
    strSuchmaske = "*TEST*"
'    strSuchmaske = InputBox("Wonach soll gesucht werden?")
    SUCHORDNER "C:\SUCHORDNER", strSuchmaske
End Sub

Sub SUCHORDNER(strFolder, strFind$)
    Dim SourceFolder As Object, SubFolder As Object, strFilename$, strFilenameOld$, i&
    Const strZielordner$ = "D:\ZIELORDNER\"
    Set SourceFolder = CreateObject("Scripting.FileSystemObject").GetFolder(strFolder)
    For Each SubFolder In SourceFolder.SubFolders
        strFilename = Dir(SubFolder & "\" & strFind, vbNormal)
        Do Until Len(strFilename) = 0
            i = 1
            strFilenameOld = strFilename
            Do Until Not CreateObject("Scripting.FileSystemObject").FileExists(strZielordner & strFilename)
                i = i + 1
                strFilename = Left(strFilenameOld, InStrRev(strFilenameOld, ".") - 1) & i & Right(strFilenameOld, Len(strFilenameOld) - InStrRev(strFilenameOld, ".") + 1)
            Loop
            FileCopy SubFolder & "\" & strFilenameOld, strZielordner & strFilename
            strFilename = Dir$
        Loop
        Call SUCHORDNER(SubFolder, strFind)
    Next SubFolder
End Sub


Änderungswunsch:

Wenn die Datei TEST.txt heißt, funktioniert es... wenn die Datei nur TEST (ohne Suffix) heißt, dann funktioniert es logischerweise nicht mehr...

Frage 1:
Welche Anpassung müsste erfolgen, damit Dein SUUUPER-KOPIER-FUNKTION auch noch dann funktioniert, wenn die Dateien KEIN Suffix hätten...

Frage 2:
Gibt es eine Kombilösung? Also, dass sowohl TEST.txt sowie TEST gesucht und kopiert werden?
rogstar
learning by doing


Verfasst am:
26. Apr 2012, 11:48
Rufname:
Wohnort: _Hessen_

AW: VBA - Dateien aus mehreren Unterverzeichnissen kopieren - AW: VBA - Dateien aus mehreren Unterverzeichnissen kopieren

Nach oben
       Version: Office 2007

Versuch es mal so
Code:
Sub DATEI_KOPIEREN()
    Dim strSuchmaske$
    strSuchmaske = "*TEST*"
'    strSuchmaske = InputBox("Wonach soll gesucht werden?")
    SUCHORDNER "C:\SUCHORDNER", strSuchmaske
End Sub

Sub SUCHORDNER(strFolder, strFind$)
    Dim SourceFolder As Object, SubFolder As Object, strFilename$, strFilenameOld$, i&
    Const strZielordner$ = "D:\ZIELORDNER\"
    Set SourceFolder = CreateObject("Scripting.FileSystemObject").GetFolder(strFolder)
    For Each SubFolder In SourceFolder.SubFolders
        strFilename = Dir(SubFolder & "\" & strFind, vbNormal)
        Do Until Len(strFilename) = 0
            i = 1
            strFilenameOld = strFilename
            Do Until Not CreateObject("Scripting.FileSystemObject").FileExists(strZielordner & strFilename)
                i = i + 1
                If InStrRev(strFilenameOld, ".") > 0 Then
                    strFilename = Left(strFilenameOld, InStrRev(strFilenameOld, ".") - 1) & i & Right(strFilenameOld, Len(strFilenameOld) - InStrRev(strFilenameOld, ".") + 1)
                Else
                    strFilename = strFilenameOld & i
                End If
            Loop
            FileCopy SubFolder & "\" & strFilenameOld, strZielordner & strFilename
            strFilename = Dir$
        Loop
        Call SUCHORDNER(SubFolder, strFind)
    Next SubFolder
End Sub

_________________
Gruß, Tobias
Phanto
Im Profil kannst Du frei den Rang ändern


Verfasst am:
31. Jan 2014, 11:27
Rufname:
Wohnort: Rhein-Main


AW: VBA - Dateien aus mehreren Unterverzeichnissen kopieren - AW: VBA - Dateien aus mehreren Unterverzeichnissen kopieren

Nach oben
       Version: Office 2007

Hallo zusammen,

Ich nutze den Code und er ist für meine Bedürfnisse fast perfekt.
Ich würde ihn nur gerne so ändern das vorhandene Dateien nicht kopiert und nicht überschrieben werden.
Kann man das in diesem Code ändern?

Gruß
Sven
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel Formeln: Sverweis mit mehreren Ergebnissen 2 Holly 1743 19. Feb 2005, 21:23
Arnim Sverweis mit mehreren Ergebnissen
Keine neuen Beiträge Excel Formeln: Runden von mehreren Zellen gleichzeitig 2 p_fr1968 3274 26. Jan 2005, 11:20
p_fr1968 Runden von mehreren Zellen gleichzeitig
Keine neuen Beiträge Excel Formeln: Teilinhalt einer Zelle in einer neuen Zelle kopieren 2 nastromo2001 2812 24. Jan 2005, 18:48
nastromo2001 Teilinhalt einer Zelle in einer neuen Zelle kopieren
Keine neuen Beiträge Excel Formeln: Verknüpfungen nach Kopieren eines Verzeichnises 17 Toledo 4274 12. Jan 2005, 10:27
Toledo Verknüpfungen nach Kopieren eines Verzeichnises
Keine neuen Beiträge Excel Formeln: summenprodukt mit monatsabfrage und mehreren bedingungen 2 Gast 3497 21. Dez 2004, 14:00
Kottan summenprodukt mit monatsabfrage und mehreren bedingungen
Keine neuen Beiträge Excel Formeln: SummeWenn mit 2 oder mehreren Bedingungen 1 jones 2000 1134 20. Dez 2004, 15:29
Kuwe SummeWenn mit 2 oder mehreren Bedingungen
Keine neuen Beiträge Excel Formeln: abfrage gestalten mit mehreren bedingungen 3 Gast 1303 15. Dez 2004, 16:58
nugget abfrage gestalten mit mehreren bedingungen
Keine neuen Beiträge Excel Formeln: Zählenwenn mit mehreren Kriterien 1 Später Gast 1560 10. Dez 2004, 21:05
Später Gast Zählenwenn mit mehreren Kriterien
Keine neuen Beiträge Excel Formeln: Teile aus Zellen ersetzen und kopieren?? 2 Marbi 1145 03. Dez 2004, 14:49
Gast Teile aus Zellen ersetzen und kopieren??
Keine neuen Beiträge Excel Formeln: SUMMEWENN mit mehreren Argumenten - geht dass 3 ExcelFan 1652 22. Nov 2004, 10:54
ExcelFan SUMMEWENN mit mehreren Argumenten - geht dass
Keine neuen Beiträge Excel Formeln: Wenn-Bedingung mit mehreren Spalten und Zeile 6 Lusie 2819 02. Nov 2004, 15:57
Lusie Wenn-Bedingung mit mehreren Spalten und Zeile
Keine neuen Beiträge Excel Formeln: Frage wegen Kopieren von Tabelle1 in Tabelle2 1 SnowStorm 961 03. Okt 2004, 17:07
ae Frage wegen Kopieren von Tabelle1 in Tabelle2
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Microsoft Excel Tricks