Order suchen in einem Verzeicnisbaum

Hallo zusammen,
hat jetzt zwar nicht direkt was mit Excel zu tun, ich bin aber erst mal ratlos.
Folgende Sachlage: Ein (ur)altes DBF-Programm (ja, sowas läuft noch), erstellt eine Reihe von Worddateien, die es in einem temporären Ordner gespeichert werden.
Die zwei ersten Wörter der Dateien sind der Nach- und Vorname der Person.
Diese Dateien müssen dann einzeln (!) verschoben werden.
Das Zielverzeichnis befindet sich in einem sehr Komplexen Verzeichnisbaum.
Das braucht enorm viel Zeit.
Ich möchte also ein VBA Programm erstellen (in Word bevorzugt, Excel geht aber auch), der diese Dateien automatisch verschiebt.
Das Problem ist also den Pfad zum richtigen Verzeichnis zu finden.
Vielen Dank für Eure Hilfe.
Gruß aus Belgien,
Marc

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Declare Function OemToCharA Lib "user32.dll" (ByVal lpszSrc As String, ByVal lpszDst As _ String) As Long Public Function F_ASC_ANS(ByVal Text As String) As String OemToCharA Text, Text F_ASC_ANS = Text End Function

Sub M_snb() Application.ScreenUpdating = False sn = Split(F_ASC_ANS(CreateObject("wscript.shell").exec("cmd /c Dir ""V:\xxx\xx\x\*blabla*. _ xls"" /b/s").stdout.readall), vbCrLf) With ThisWorkbook.Worksheets(1) .UsedRange.ClearContents For j = 0 To UBound(sn) - 1 .Cells(.Cells(Rows.Count, 2).End(xlUp).Row + 1, 1) = sn(j) Set wkb = Workbooks.Open(sn(j)) wkb.Worksheets(1).Range("B4:L" & wkb.Worksheets(1).Cells(Rows.Count, 2).End(xlUp). _ Row).Copy .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 2) wkb.Close False Set wkb = Nothing Next End With Application.ScreenUpdating = True MsgBox "Anzahl der Dateien: " & UBound(sn) End Sub

Declare Function MoveFileExW Lib "KERNEL32.DLL" _ ( _ ByVal lpExistingFileName As Long, _ ByVal lpNewFileName As Long, _ ByVal dwFlags As Long _ ) As Long Sub dirordner() Dim sDeinRootFolder As String sDeinRootFolder = >> 'auslesen der Ordner und in Spalte A schubsen Call CreateObject("wscript.shell").Run("cmd.exe /c dir /S /B /A:D " & _ sDeinRootFolder & "|clip", 0, True) Tabelle1.Range("A1").PasteSpecial 'auslesen der Dateien, in Spalte B packen Call CreateObject("wscript.shell").Run("cmd.exe /c dir /b " & _ sDeinRootFolder & "\*.txt" & "|clip", 0, True) Tabelle1.Range("B1").PasteSpecial 'mal eine der Dateien in einen der Ordner verschieben MoveFileExW StrPtr(sDeinRootFolder & "\" & Tabelle1.Range("B2")), StrPtr(Tabelle1.Range("A1" _ ) & "\" & Tabelle1.Range("B2")), 0 End Sub

Ich habe eine Lösung gefunden.
Diese benutzt das Scripting.FileSystemObject.
Ich darf hier den Code nicht ganz veröffentlichen, so steht es in den Anmerkungen das Autors.
Autor ist Marc Wershoven und der direkte Link zum vollständigen Code ist https://www.online-vba.de/vba_readfolder.php
Zusätzlich soviel:
Da ich ja nur den Verzeichnisbaum einlesen muss, in dem "irgendwo" das Zielverzeichnis meiner zu verschiebenden Dateien liegt, habe ich die Routine teilweise abgeändert.
Ich erhalte jetzt, vorläufig als Excel-Tabelle, später in einem Array den vollständigen Verzeichnisbaum, einschließlich der Ordner in denen keine Dateien gespeichert sind, was ja durchaus möglich ist. Letzteres war bisher auch noch nicht gegeben.
Hier mein abgeänderter Abschnitt:


With oSheet
For Each oSubFolder In oFolder.subfolders
'Alle Ordner auflisten
If Not .Cells(lRowCounter - 1, 1) = oSubFolder.Path & "\" Then
.Cells(lRowCounter, 1) = oSubFolder.Path & "\"
lRowCounter = lRowCounter + 1
End If
'Alle Unterverzeichnisse verarbeiten (rekursiv)
Call MWReadSubFolder(oSubFolder.Path)
Next oSubFolder
End With

Damit kann ich problemlos arbeiten. Auch die Umlaute bleiben hiermit erhalten.
Nochmals vielen herzlichen Dank für die vielen guten Ansätze und Ideen. Danke für Eure Mühen und Bemühungen ein zufriedenstellendes Resultat zu erhalten.

Beliebteste Forumthreads (12 Monate)

Order suchen in einem Verzeicnisbaum

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread