Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1476to1480
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Datei suchen

Datei suchen
18.02.2016 16:26:13
Hartmut_M
Hallo, bitte helft mir bei folgendem Problem.
Ist es möglich per VBA eine Datei auf einem Laufwerk zu suchen und den Pfad in einer msgbox auszugeben? Es ist nicht bekannt, in welchem Ordner die Datei liegt.
Also ich suche auf dem Laufwerk Y:\ eine Datei "Test.txt", die dort in irgendeinem Ordner liegt. Habe mit google nichts gefunden. Wäre nett, wenn mir jemand helfen könnte.
Gruß Hartmut

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datei suchen
18.02.2016 17:01:21
Hartmut_M
Hallo Chris, danke für den link.
Der code sieht ja erschreckend aus, funktioniert aber größtenteils.
Allerdings wird im Direktbereich nur der Dateiname angezeigt aber nicht der Pfad.
Muss mich erstmal durch den Code wühlen. :-(
Hatte mir eigentlich eine kürzere Möglichkeit vorgestellt.
Gruß Hartmut

AW: Datei suchen
18.02.2016 19:06:56
Piet
Hallo Hartmut
ich kenne den Code von Nepumuk, verstanden habe ich ihn nicht.
Anbei ein wesentlich kürzer Code aus meinem Thread:
 Ordner mir U-Ordner + Dateien einlesen - Piet 15.02.2016 14:57:01
 AW: Ordner einlesen - von Rudi Maintaire am 16.02.2016 10:29:19
Der Dank gebürt Rudi Maintaire. Er listet zwar alles auf, ist aber egal
Man findet die Datei auf jeden Fall im Ordner. Danke an Rudi ....
mfg Piet
Option Explicit
Sub DateiListe()
Dim FSO As Object, oFolder As Object, oDictF As Object
Dim strFolder As String, arrHeader, wksListe As Worksheet
Dim lngColumns As Long
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Ordner wählen"
.AllowMultiSelect = False
If .Show = -1 Then
strFolder = .SelectedItems(1)
End If
End With
If strFolder = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(strFolder)
Set oDictF = CreateObject("Scripting.dictionary")
arrHeader = Array("Name", "Ext", "Ordner", "kB", "le.Änd.", "Erstellt", "Pfad", "Link")
lngColumns = UBound(arrHeader) + 1
prcFiles oFolder, oDictF
prcSubFolders oFolder, oDictF
On Error Resume Next
Set wksListe = ThisWorkbook.Sheets("DateiListe")
On Error GoTo 0
If wksListe Is Nothing Then
Set wksListe = Worksheets.Add(before:=Sheets(1))
wksListe.Name = "DateiListe"
End If
With wksListe
.Cells.Clear
.Cells(1, 1).Resize(, lngColumns) = arrHeader
.Cells(1, 1).Resize(, lngColumns).Font.Bold = True
'korerektur
If oDictF.Count > 0 Then
.Cells(2, 1).Resize(oDictF.Count, lngColumns).FormulaLocal _
= WorksheetFunction.Transpose(WorksheetFunction.Transpose(oDictF.Items))
Else
With .Cells(2, 1)
.Value = "No Files in " & oFolder
With .Font
.Bold = True
.Size = 16
.Color = RGB(255, 0, 0)
End With
End With
End If
.Columns.AutoFit
.Activate
End With
End Sub

Sub prcFiles(oFolder, oDictF)
Dim oFile As Object
For Each oFile In oFolder.Files
With oFile
oDictF(.Path) = Array( _
Left(.Name, InStrRev(.Name, ".") - 1), _
Replace(.Name, Left(.Name, InStrRev(.Name, ".")), ""), _
oFolder, _
Int(.Size / 1024), _
.DateLastModified, _
.DateCreated, _
.Path, _
"=HYPERLINK(""" & .Path & """;""" & "Klick" & """)")
End With
Next
End Sub

Sub prcSubFolders(oFolder, oDictF)
Dim oSubFolder As Object
For Each oSubFolder In oFolder.SubFolders
prcFiles oSubFolder, oDictF
prcSubFolders oSubFolder, oDictF
Next
End Sub

'Gruß
'Rudi

Anzeige
AW: Datei suchen
19.02.2016 09:33:41
Hartmut_M
Hallo Piet,
erstmal vielen Dank für deine Rückmeldung.
Werde versuchen, den Code zu verstehen.
Habe ihn rüberkopiert. Programm läuft jetzt schon einige Minuten.
Mal sehen, was bei rauskommt.
Ich weiß allerdings nicht, ob das schon die optimale Lösung ist, um den Pfad für eine bestimmte Datei angezeigt zu bekommen.
Viele Grüße Hartmut

Datei suchen
19.02.2016 15:45:49
Anton
Hallo Hartmut,
probier's hiermit:
Private Declare Function OemToCharA Lib "user32.dll" (ByVal lpszSrc As String, _
ByVal lpszDst As String) As Long
Public Function ASCIItoANSI(ByVal Text As String) As String
Call OemToCharA(Text, Text)
ASCIItoANSI = Text
End Function
Private Sub datei_suche()
Dim objShell As Object, objExec As Object, i As Long
Dim vntRet As Variant, strDatei As String, strTMP As String
strDatei = "Test.txt" 'anpassen
Set objShell = CreateObject("WScript.Shell")
ChDrive "Y:"
ChDir "Y:\"
Set objExec = objShell.Exec("cmd /c dir /s /b /a:-d " & strDatei)
strTMP = ASCIItoANSI(objExec.StdOut.ReadAll)
vntRet = Split(strTMP, vbCrLf)
If UBound(vntRet) > 0 Then
For i = 0 To UBound(vntRet) - 1
MsgBox vntRet(i)
Next
End If
Set objShell = Nothing
End Sub
mfg Anton

Anzeige
AW: Datei suchen
22.02.2016 10:50:11
Hartmut_M
Hallo Anton,
das sieht sehr gut aus. So hatte ich mir das vorgestellt.
Herzlichen Dank für deine Hilfe.
Eine Frage noch. Bei Ausführung des Codes wird das schwarze cmd.exe Fenster angezeigt, das sich dann von alleine wieder schließt. Dies wird auch mit "Application.ScreenUpdating = False" nicht verhindert. Kann ich das Einblenden dieses Fensters verhindern?
Gruß Hartmut

AW: Datei suchen
22.02.2016 15:30:23
Anton
Hallo Hartmut,
objShell.Exec("cmd /c dir /s /b /a:-d " & strDatei)
ruft das cmd Fenster auf.
Wie man das Einblenden dieses Fensters verhindern kann, weiß ich nicht.
PS: Ich würde sowieso das so lassen, als Anzeige, dass das Makro läuft noch...
mfg Anton

Anzeige
AW: Datei suchen
22.02.2016 15:42:09
Hartmut_M
Okay. Nochmals Danke für deine Unterstützung.
Gruß Hartmut

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige