AW: Daten speichetn
05.01.2019 21:42:26
Dieter
Hallo Joachim,
das ist ja ein lässiger Programmierauftrag, den du hier erteilst.
Ich hab dir trotzdem mal ein Programm aus meinen vorhandenen Beispielen zusammengestellt.
Deine Anforderungen musst du sicher noch präzisieren. Ich gehe bei der Suche von einem festen Verzeichnis aus und suche in diesem Ausgangsverzeichnis und in allen Unterverzeichnissen. Gespeichert werden die gefundenen Dateien in dem Verzeichnis "C:\Temp\".
Wenn du nach einer Datei in verschiedenen Unterverzeichnissen suchst, dann musst du davon ausgehen, dass du sie in mehreren Unterverzeichnissen findest. Ich speichere immer nur die erste, die ich finde.
Noch eine Anmerkung: Du hast in einem Programmrudiment das FileSearch-Objekt verwendet. Dieses Objekt gibt es seit Office 2007 nicht mehr.
Option Explicit
Public anzGefunden As Long
Public Gefunden() As Folder
Sub DateienSuchen()
' Erfordert Verweis auf "Microsoft Scripting Runtime"
Dim datName As String
Dim fso As FileSystemObject
Dim folSuch As Folder
Dim folZiel As Folder
Dim i As Long
Dim letzteZeile As Long
Dim spalte As Long
Dim suchVerzeichnis As String
Dim ws As Worksheet
Dim zeile As Long
Dim zielFolder As Folder
Dim zielVerzeichnis As String
' In dem Verzeichnis suchVerzeichnis und in den
' zugehörigen Unterverzeichnissen wird gesucht
suchVerzeichnis = ThisWorkbook.Path & "\"
' In dem Verzeichnis zielVerzeichnis werden
' die gefundenen Dateien gespeichert
zielVerzeichnis = "C:\Temp\"
Set fso = New FileSystemObject
Set folSuch = fso.GetFolder(suchVerzeichnis)
If Not fso.FolderExists(zielVerzeichnis) Then
Set folZiel = fso.CreateFolder(zielVerzeichnis)
Else
Set folZiel = fso.GetFolder(zielVerzeichnis)
End If
Set ws = ThisWorkbook.Worksheets(1)
letzteZeile = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For zeile = 2 To letzteZeile
datName = ws.Cells(zeile, "A") & "." & ws.Cells(zeile, "B")
anzGefunden = 0
VerzeichnisSuchen folSuch, datName
If anzGefunden > 0 Then
spalte = 3
For i = 1 To anzGefunden
ws.Cells(zeile, spalte) = Gefunden(i).Path
spalte = spalte + 1
Next i
' Datei aus dem ersten gefundenen Verzeichnis in das
' Zielverzeichnis kopieren
fso.CopyFile Source:=Gefunden(1).Path & "\" & datName, _
Destination:=zielVerzeichnis, _
Overwritefiles:=True
Else
ws.Cells(zeile, "C") = "Kein Verzeichnis gefunden"
End If
Next zeile
Set fso = Nothing
End Sub
Sub VerzeichnisSuchen(Verzeichnis As Folder, _
Datei As String)
Dim fil As file
Dim i As Long
Dim unterVerz As Folder
' Prüfen, ob Zugriff zu dem Verzeichnis fol besteht
' (z.B. besteht kein Zugriff auf den Ordner
' "C:\System Volume Information")
' Falls kein Zugriff möglich ist, wird der Ordner übergangen.
On Error GoTo FehlerBeh
i = Verzeichnis.Files.Count
On Error GoTo 0
' Es besteht Zugriff auf das Verzeichnis fol
For Each fil In Verzeichnis.Files
If fil.Name = Datei Then
anzGefunden = anzGefunden + 1
ReDim Preserve Gefunden(1 To anzGefunden)
Set Gefunden(anzGefunden) = Verzeichnis
Exit For
End If
Next fil
For Each unterVerz In Verzeichnis.SubFolders
VerzeichnisSuchen unterVerz, Datei
Next unterVerz
Exit Sub
FehlerBeh:
Select Case Err.Number
Case 70 ' Fehlernr. 70: "Zugriff verweigert"
Case Else
MsgBox Err.Number & vbNewLine & Err.Description
End Select
Exit Sub
End Sub
Viele Grüße
Dieter
https://www.herber.de/bbs/user/126521.xlsm