[VBA] Order suchen und Dateiauswahl

Moin moin,

ich habe hier so ein kleines Problem :)

Ich möchte durch Eingabe einer Auftragsnummer den entsprechenden Ordner inkl. Unterordner in einem Netzlaufwerk finden - wenn der Ordner gefunden wurde soll sich der Explorer / Dateiauswahl öffnen und ich wähle eine Datei in dem Ordner, nach Bestätigung soll der Pfad in eine TexBox geschrieben werden.

Ich habe es mit folgendem Code probiert:

'Dateiauswahl nach Ordnersuche via Auftragsnummer'
Private Sub CommandButton3_Click()

    Dim suche As String
    Dim Dateiname
    strPfad = "Y:\Auftragsdokumentation"
        suche = TextBox6.Value
        
        
            If suche = "" Then
            MsgBox "Keine Auftragsnummer eingegeben"

Else
    Dateiname = Dir((strPfad & suche & "*"))
    If Dateiname > "" Then
                
        strPfad = Application.GetOpenFilename
    If strPfad > False Then
        TextBox14 = strPfad
        Else
        MsgBox "Keine Datei ausgewählt!"
    End If
Else
    MsgBox "Kein Auftrag gefunden"
End If
End If
    
    
End Sub

Was funktioniert ist das registriert wird wenn keine Auftragsnummer eingetragen wurde - allerdings wird nach Eingabe einer Auftragsnummer kein entsprechender Auftrag / Ordner gefunden und es öffnet sich auch kein Dateiexplorer. Die Auftragsnummer ist immer unterschiedlich und wird nur einmalig vergeben.

Ich hoffe ihr könnt mir weiterhelfen.
Grüße Christian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Nummernsuche() Dim StartVerzeichnis As String Dim Verzeichnisse Dim V As Long Dim Suche As String Dim Datei As String StartVerzeichnis = "Y:\Auftragsdokumentation" Suche = Textbox6.Text ReDim Verzeichnisse(0) Verzeichnisse(0) = StartVerzeichnis V = 0 Do Until V > UBound(Verzeichnisse) Datei = Dir(Verzeichnisse(V) & "\*", vbDirectory) Do Until Datei = "" If Datei = "." Or Datei = ".." Then 'nix machen ElseIf (GetAttr(Verzeichnisse(V) & "\" & Datei) And vbDirectory) = vbDirectory Then ReDim Preserve Verzeichnisse(UBound(Verzeichnisse) + 1) Verzeichnisse(UBound(Verzeichnisse)) = Verzeichnisse(V) & "\" & Datei ElseIf Datei Like "*" & Suche & "*" Then GoTo DateiGefunden Else End If Datei = Dir Loop V = V + 1 Loop MsgBox "kein Treffer für: " & Suche Exit Sub DateiGefunden: ChDrive Left(verzeichnis(V), 1) ChDir verzeichnis(V) Datei = Application.GetOpenFilename TextboxXXX.Text = Datei End Sub

Sub Nummernsuche() Dim StartVerzeichnis As String Dim Verzeichnisse Dim V As Long Dim Suche As String Dim Datei As String StartVerzeichnis = "Y:\Auftragsdokumentation" Suche = Textbox6.Text ReDim Verzeichnisse(0) Verzeichnisse(0) = StartVerzeichnis V = 0 Do Until V > UBound(Verzeichnisse) Datei = Dir(Verzeichnisse(V) & "\*", vbDirectory) Do Until Datei = "" If Datei = "." Or Datei = ".." Then 'nix machen ElseIf (GetAttr(Verzeichnisse(V) & "\" & Datei) And vbDirectory) = vbDirectory Then If Datei Like "*" & Suche & "*" Then GoTo DateiGefunden else ReDim Preserve Verzeichnisse(UBound(Verzeichnisse) + 1) Verzeichnisse(UBound(Verzeichnisse)) = Verzeichnisse(V) & "\" & Datei end if Else End If Datei = Dir Loop V = V + 1 Loop MsgBox "kein Treffer für: " & Suche Exit Sub DateiGefunden: ChDrive Left(verzeichnis(V), 1) ChDir verzeichnis(V) Datei = Application.GetOpenFilename TextboxXXX.Text = Datei End Sub

DateiGefunden: ChDrive Left(Verzeichnisse(V), 1) ChDir (Verzeichnisse(V) & "\" & Datei) Datei = Application.GetOpenFilename If Datei > False Then TextBox14.Text = Datei Else MsgBox "Keine Datei ausgewählt!" End If

DateiGefunden: ChDrive Left(Verzeichnisse(V), 1) ChDir (Verzeichnisse(V) & "\" & Datei & SonderPfad) strPfad = Application.GetOpenFilename If strPfad > False Then TextBox7 = strPfad End If

Sub aaa() Dim strPfad As String, strOrdner As String, strSuch As String strPfad = "c:\test\" strSuch = Range("A1") & "*" If strSuch = "" Then MsgBox "keine Nummer": Exit Sub strOrdner = Dir(strPfad & strSuch, vbDirectory) If strOrdner > "." Then With Application.FileDialog(msoFileDialogFilePicker) .InitialFileName = strPfad & strOrdner If .Show Then Range("B1") = .SelectedItems(1) End If End With End If End Sub

Sub aaa() Dim strPfad As String, strOrdner As String, strSuch As String strPfad = "c:\test\" strSuch = Range("A1") & "*" If strSuch = "" Then MsgBox "keine Nummer": Exit Sub strOrdner = Dir(strPfad & strSuch, vbDirectory) If strOrdner > "." Then With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = strPfad '& strOrdner If .Show Then Range("B1") = .SelectedItems(1) End If End With End If End Sub

Beliebteste Forumthreads (12 Monate)

[VBA] Order suchen und Dateiauswahl

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

[VBA] Order suchen und Dateiauswahl

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread