Hi,
ich möchte über die Eingabe eines Suchbegriffes ein gezieltes Verzeichnis (z.B: C:\Exel… ) inkl dessen Unterverzeichnisse nach Dateien durchsuchen. Dabei sind die ersten 11Zeichen des Dateinamen immer gleich und ab dem 12.Zeichen folgt der zu suchende Begriff der immer aus 4 Zeichen besteht. Danach folgt dann noch eine variabel lange Ziffer, die aber nicht interessiert.
Zum einen, wie lasse ich den Pfad durchsuchen und
zum Anderen, wie starte ich die Datei (immer Excel) wenn ich sie gefunden habe?
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias \_
"FindFirstFileA" (ByVal lpFileName As String, \_
lpFindFileData As WIN32\_FIND\_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias \_
"FindNextFileA" (ByVal hFindFile As Long, \_
lpFindFileData As WIN32\_FIND\_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal \_
hFindFile As Long) As Long
Private Const MAX\_PATH = 260
Private Const INVALID\_HANDLE\_VALUE = -1
Private Const FILE\_ATTRIBUTE\_ARCHIVE = &H20
Private Const FILE\_ATTRIBUTE\_DIRECTORY = &H10
Private Const FILE\_ATTRIBUTE\_HIDDEN = &H2
Private Const FILE\_ATTRIBUTE\_NORMAL = &H80
Private Const FILE\_ATTRIBUTE\_READONLY = &H1
Private Const FILE\_ATTRIBUTE\_SYSTEM = &H4
Private Const FILE\_ATTRIBUTE\_TEMPORARY = &H100
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32\_FIND\_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String \* MAX\_PATH
cAlternate As String \* 14
End Type
Private m\_lngDirCount As Long
Private m\_lngFileCount As Long
Private m\_astrFiles() As String
Private Sub Suchen(Path as String, Kriterium as String)
Dim i As Long
Dim strMsg As String
m\_lngDirCount = 1
m\_lngFileCount = 0
ReDim m\_astrFiles(0 To 100)
FindFiles Path, Kriterium
End Sub
Private Sub FindFiles(ByVal vsFolderPath As String, \_
ByVal vsSearch As String)
Dim WFD As WIN32\_FIND\_DATA
Dim hSearch As Long
Dim strDirName As String
DoEvents
If Right$(vsFolderPath, 1) "\" Then
vsFolderPath = vsFolderPath & "\"
End If
hSearch = FindFirstFile(vsFolderPath & "\*.\*", WFD)
If hSearch INVALID\_HANDLE\_VALUE Then
GetFilesInFolder vsFolderPath, vsSearch
Do
If (WFD.dwFileAttributes And FILE\_ATTRIBUTE\_DIRECTORY) Then
strDirName = TrimNulls(WFD.cFileName)
If (strDirName ".") And (strDirName "..") Then
m\_lngDirCount = m\_lngDirCount + 1
FindFiles vsFolderPath & strDirName, vsSearch
End If
End If
Loop While FindNextFile(hSearch, WFD)
FindClose hSearch
End If
End Sub
Private Sub GetFilesInFolder(ByVal vsFolderPath As String, \_
ByVal vsSearch As String)
Dim WFD As WIN32\_FIND\_DATA
Dim hSearch As Long
Dim strFileName As String
If Right$(vsFolderPath, 1) "\" Then
vsFolderPath = vsFolderPath & "\"
End If
hSearch = FindFirstFile(vsFolderPath & vsSearch, WFD)
If hSearch INVALID\_HANDLE\_VALUE Then
Do
If (WFD.dwFileAttributes And FILE\_ATTRIBUTE\_DIRECTORY) \_
FILE\_ATTRIBUTE\_DIRECTORY Then
strFileName = TrimNulls(WFD.cFileName)
m\_astrFiles(m\_lngFileCount) = vsFolderPath & strFileName
m\_lngFileCount = m\_lngFileCount + 1
If (m\_lngFileCount Mod 100) = 0 Then
ReDim Preserve m\_astrFiles(m\_lngFileCount + 100)
End If
End If
Loop While FindNextFile(hSearch, WFD)
FindClose hSearch
End If
End Sub
Private Function TrimNulls(ByVal vsStringIn As String) As String
If InStr(vsStringIn, Chr(0)) \> 0 Then
vsStringIn = Left$(vsStringIn, InStr(vsStringIn, Chr(0)) - 1)
End If
TrimNulls = vsStringIn
End Function
Unter m_lngDirCount hast du die Anzahl der Verzeichnisse die durchsucht wurden. Unter m_lngFileCount die Anzahl der Files die gefunden wurden
In dem Array m_astrFiles stehen die gefunden Dateien, incl. Pfad.
Externe Dateien kannst du dann wiefolgt starten.
Option explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias \_
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation \_
As String, ByVal lpFile As String, ByVal lpParameters \_
As String, ByVal lpDirectory As String, ByVal nShowCmd \_
As Long) As Long
Private Sub Starte\_File(Filename as string)
on error resume next
Call ShellExecute(Me.hwnd, "Open", Filename, "", , 1)
end sub
So wenn du nun beides kombinierst hast du den gewünschten Effekt.
MFG Alex
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
