05.01.2022, 12:26
Moin,
dank Dr. Google habe ich einen Code gefunden (ich glaube der ist sogar von steve1da, bin mir aber nicht sicher), der Dateien öffnet. Der müsste aber so umgeschrieben werden, dass sich nur ein Ordner öffnet und keine Datei. In der TextBox sollen auch immer nur Ordnernamen eingegeben und diese dann geöffnet werden.
Ich steh da grad nen bissl aufm Schlauch 
dank Dr. Google habe ich einen Code gefunden (ich glaube der ist sogar von steve1da, bin mir aber nicht sicher), der Dateien öffnet. Der müsste aber so umgeschrieben werden, dass sich nur ein Ordner öffnet und keine Datei. In der TextBox sollen auch immer nur Ordnernamen eingegeben und diese dann geöffnet werden.
Code:
Option Explicit
#If Win64 Then
Private Declare PtrSafe Function SearchTreeForFile Lib "imagehlp.dll" _
(ByVal RootPath As String, ByVal InputPathName As String, _
ByVal OutputPathBuffer As String) As Long
#End If
#If Win64 Then
Private Declare PtrSafe 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
#End If
Private Const SW_MAXIMIZE = 3
Const strPath As String = "C:\Users\StefanB\Desktop"
Private Sub CommandButton1_Click()
Dim strPathName As String * 255
Dim strName As String
Dim lngTMP As Long
On Error GoTo Fin
If Trim(TextBox1.Text) <> "" Then
lngTMP = SearchTreeForFile(strPath, "*" & TextBox1.Text & "*", strPathName)
If lngTMP = 0 Then
' Datei nicht vorhanden!
MsgBox "File not found!"
Else
strPathName = Left$(strPathName, InStr(1, strPathName, vbNullChar) - 1)
strName = RTrim(strPathName)
ShellExecute 0, "Open", strName, "", "", SW_MAXIMIZE
End If
End If
Fin:
If Err.Number <> 0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
