Clever-Excel-Forum

Hallo VBA-Freunde,

ich knoble gerade an einer Verbesserung einer Arbeitsmappe.

Dazu möchte ich gerne den Pfad zu einer bestimmten Datei auf dem Server auslesen lassen.

Die Datei heißt z.B. collectingsheet.xlsm und steht bei mir im Verzeichnis C:\BUCON.

Da müssten eigentlich alle für das Projekt relevanten Dateien drinstehen:
QNT.XLSM
Collectingsheet.xlsm
Smartsheet.xlsm
usw-

Ich möchte nun diese Namen in eine Zelle schreiben und per VBA-Code soll mein Rechner und alle Laufwerksordner in meinem Bereich durchgesucht werden, wo die Datei steht.

Ist das überhaupt möglich?

Vielen Dank für eure Antworten.

Heinz

Hallo Heinz,

hier mal ein Beispielcode. Beschreibung siehe Kommentare. Die Ergebnisse gebe ich zusätzlich nochmal mit dem Dateinamen aus, da der code für mehrere Fundorte einer Datei ausgelegt ist.

Arbeitsblatt mit dem Namen 'Tabelle1'
	A	B	C
1	Suche in:	C:\Test
2	Suchname	Treffername	Treferpfad
3	Export.xlsx	Export.xlsx	C:\Test\Mieze
4	Daten.zip	Export.xlsx	C:\Test\Theo\Neuer Ordner
5		Daten.zip	C:\Test

DefStr S
DefObj O
Sub FileSearch()
'Variablendeklaration 
'String ueber DefStr 
Dim strSPath, strFile, strMyMsg
'Integer 
Dim iCnt%
'Startpfad festlegen, hier aus Zelle B1 des aktiven Blattes 
strSPath = Cells(1, 2)
'Schleife ueber alle Dateien, ab A3 des aktiven Blattes 
For iCnt = 3 To Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1).Row
  'Filename festlegen 
  strFile = Cells(iCnt, 1).Value
  'Dateisuche beginnen 
  strMyMsg = f_FileSearch(strSPath, strFile, strMyMsg)
'Ende Schleife ueber alle Dateien, ab A2 des aktiven Blattes 
Next
MsgBox "Treffer: " & strMyMsg
End Sub

Function f_FileSearch(strPath, strFile, ByRef strMyMsg) As String
'Verweis auf Microsoft Scripting Runtime setzen 
'Variablendeklaration 
'FileSystem Objekte 
Dim objFSO As New FileSystemObject
Dim objFile As File
'Object ueber DefObj 
Dim objDirs As Folder, objFolder As Folder
'Ordner setzen 
Set objFolders = objFSO.GetFolder(strPath)
'Schleife fuer rekursive abarbeitung 
For Each objFolder In objFolders.SubFolders
  'Erneuter Funktionsaufruf mit einem Unterordner 
  f_FileSearch = f_FileSearch(objFolder.Path, strFile, strMyMsg)
'Ende Schleife fuer rekursive abarbeitung 
Next
'Schleife ueber alle Dateien des Ordners / Unterordners 
For Each objFile In objFolders.Files
  'Wenn der Dateiname dem Suchname entpricht, dann 
  If objFile.Name = strFile Then
    'Ausgabe des Dateinamen und Pfad im Direktfenster 
    Debug.Print objFile.Name & vbTab & objFile.ParentFolder
    'Ausgabe des Pfades an die Funktion 
    strMyMsg = strMyMsg & vbTab & objFile.ParentFolder
    'Ausgabe in eine Zelle des aktiven Blattes ab B2 
    With Cells(Cells(Rows.Count, 2).End(xlUp).Row + 1, _
      Cells(Cells(Rows.Count, 2).End(xlUp).Row + 1, _
        Columns.Count).End(xlToLeft).Column + 1)
      .Value = objFile.Name
      .Offset(0, 1) = objFile.ParentFolder
    'Ende Ausgabe in eine Zelle des aktiven Blattes ab B2 
    End With
  'Ende Wenn der Dateiname dem Suchname entpricht, dann 
  End If
'Ende Schleife ueber alle Dateien des Ordners / Unterordners 
Next
'Rueckgabewert zuweisen 
f_FileSearch = strMyMsg
End Function

Heinz Ulm

schauan