Private Zielordner As Outlook.MAPIFolder
Private Suchausdruck As String
Public Sub HVK_Ordnersuche()
Dim Projektnummer As String
Dim AnzahlZiffern As Integer
Dim alleOrdner As Outlook.Folders
Dim HVK As Outlook.Folder
Set Zielordner = Nothing
Projektnummer = ""
Projektnummer = InputBox("Projektnummer eingeben: ", "")
Projektnummer = Trim(Projektnummer) & "*"
AnzahlZiffern = Len(Projektnummer)
Suchausdruck = ""
Suchausdruck = Projektnummer
If AnzahlZiffern <> 6 Then
MsgBox "ungültige Projektnummer", vbInformation
End
Else
Set alleOrdner = Application.Session.Folders
Suchdurchlauf alleOrdner
If Not Zielordner Is Nothing Then
Set Application.ActiveExplorer.CurrentFolder = Zielordner
Else
MsgBox "Projektordner nicht gefunden", vbInformation
End If
End If
End Sub
Private Sub Suchdurchlauf(alleOrdner As Outlook.Folders)
Dim Unterordner As Outlook.MAPIFolder
Dim Treffer As Boolean
For Each Unterordner In alleOrdner
Treffer = (Unterordner.Name Like Suchausdruck)
If Treffer Then
Set Zielordner = Unterordner
Exit For
Else
Suchdurchlauf Unterordner.Folders
If Not Zielordner Is Nothing Then Exit For
End If
Next
End Sub