Comboboxen in abhängikeit

[Käpt'n Blaubär]

Hallo Michael,

Das ist was ich im Netz gefunden habe, der rest ist über VBA NICHT EXCEL

ich wundere mich gerade sehr.
Im Beitrag, #9 war es glaube ich, hat Stefan Dir ein VBA-Script vorgestellt
und in Deinen folgenden Beiträgen habe ich nirgendwo auch nur den kleinsten
Hinweis gelesen, daß das für Dich nicht in Frage kommt.

Abgesehen davon, daß Dein Vorhaben wahrscheinlich nur über VBA realisierbar sein
dürfte, was bitte schön soll der geneigte Leser von Deinem Verhalten halten?

[Käpt'n Blaubär]

Hallo,

ok, ich habe da wohl was durcheinandergewürfelt.
Nichts für Ungut. Sorry

[Steffl]

Hallo Michael,

ich habe bemerkt, das bei meiner Lösung nur die Ordnernamen eingelesen werden und damit alles in die ComboBox2 geschrieben wird. Wie ich da den Pfad vom Ordner auch noch reinkriege habe ich keine Ahnung und möchte mich daher ausklinken.

[michel34497]

Hallo!

Schade!
Aber vielleicht hat ein anderer noch eine Idee!

[Steffl]

Hallo Michael,

habe es doch mal versucht

Code:

Private Sub UserForm_Initialize()
   Dim strOrdner() As String
   Dim lngCounter As Long
  
   fncOrdner "N:\Wartungspläne\", strOrdner()
   For lngCounter = 0 To UBound(strOrdner)
      If UBound(Split(strOrdner(lngCounter), "\")) = 2 Then
      cbDokument.AddItem strOrdner(lngCounter)
'      MsgBox strOrdner(lngCounter)
      Else
      cbDokument2.AddItem strOrdner(lngCounter)
'      MsgBox "2 " & strOrdner(lngCounter)
      End If
   Next lngCounter
End Sub
Function fncOrdner(strPath As String, strOrdner() As String)
   Dim objFSO As Object, objFolder As Object, objOrdner As Object
   Static lngCounter As Long
  
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objFolder = objFSO.getfolder(strPath)
   For Each objOrdner In objFolder.subfolders
      ReDim Preserve strOrdner(0 To lngCounter)
      strOrdner(lngCounter) = objOrdner.Path
      lngCounter = lngCounter + 1
      fncOrdner objOrdner.Path, strOrdner()
   Next objOrdner
  
   Set objFolder = Nothing
   Set objFSO = Nothing
End Function

[michel34497]

Hallo Stefan!
Sorry das ich erst jetzt antworte (Beruflich).
Danke dir, das du dich in das Thema nochmal eingebracht hast.
Nach den ersten Test sah es gut aus mit dem Code.
Mir ist aber dann aufgefallen, das ich in CB2 schon auswählen kann ohne in CB1 eine vorauswahl zu machen.
Ich wollte ja in abhängikeit von CB1 erst (Ordner) was auswählen und dann die dazu gehörigen Ordner in CB2 sehen (so wie es im Explorer auch ist).
Kann man da nochmal was machen?  
Bitte schreiben.

Schönheits Fehler ist, das jezt auch der path mit in CB's angezeigt wird (N:\Wartungspläne\      möchte ich eigentlich Nicht, wenn's aber nicht anders geht ist es auch i.O.)

[Steffl]

Hallo,

PHP-Code:

Option Explicit
Private lngCounter As Long
Private strOrdner() As String
Private Sub UserForm_Initialize()
   Dim varText As Variant
    
   fncOrdner "N:\Wartungspläne\", strOrdner(), False
   For lngCounter = 0 To UBound(strOrdner)
      varText = Split(strOrdner(lngCounter), "\")
      cbDokument.AddItem varText(UBound(varText))
   Next lngCounter
   lngCounter = 0
 End Sub
Function fncOrdner(strPath As String, strOrdner() As String, bolUnterordner As Boolean)
   Dim objFSO As Object, objFolder As Object, objOrdner As Object
   
   On Error Resume Next
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objFolder = objFSO.getfolder(strPath)
   For Each objOrdner In objFolder.subfolders
      ReDim Preserve strOrdner(0 To lngCounter)
      strOrdner(lngCounter) = objOrdner.Path
      lngCounter = lngCounter + 1
      If bolUnterordner Then fncOrdner objOrdner.Path, strOrdner(), True
   Next objOrdner
   
   Set objFolder = Nothing
   Set objFSO = Nothing
End Function

Private Sub cbDokument_Click()
   Dim strText As String
   Dim varText As Variant
   
   strText = strOrdner(cbDokument.ListIndex)
   Erase strOrdner
   fncOrdner strText, strOrdner(), True
   For lngCounter = 0 To UBound(strOrdner)
      varText = Split(strOrdner(lngCounter), "\")
      If UBound(varText) > -1 Then cbDokument2.AddItem varText(UBound(varText))
   Next lngCounter
End Sub 


[michel34497]

Hallo Stefan!

Tausend Dank für die Hilfe !
Muss heute Abend noch genauer Testen

:100:

[michel34497]

Hallo Stefan!

Nach intensiven Test. ist es noch nicht ganz das was ich wollte, eigentlich liest der Code jetzt zu viel ein.
Habe versucht es selber das zu richten!

So wollt ich es: N:\Wartungspläne\ordner1\ordner2\
                                                       CB1      CB2
So ist es: N:\Wartungspläne\ordner1\ordner2\ordner und *.xls
                                               CB1     CB2      CB2        CB2
Er liest wenn es in dem Ordner2 noch andere Ordner gibt diese auch mit ein. So kann dann in der Combobox2 keine richtige Auswahl getroffen werden.
Kann mal da nochmal was machen?

[Steffl]

Hallo Michael,

ungetestet eine Codezeile und ein Parameter in der Funktion weniger

Code:

Private lngCounter As Long
Private strOrdner() As String
Private Sub UserForm_Initialize()
   Dim varText As Variant
    
   fncOrdner "N:\Wartungspläne\", strOrdner()
   For lngCounter = 0 To UBound(strOrdner)
      varText = Split(strOrdner(lngCounter), "\")
      cbDokument.AddItem varText(UBound(varText))
   Next lngCounter
   lngCounter = 0
End Sub
Function fncOrdner(strPath As String, strOrdner() As String)
   Dim objFSO As Object, objFolder As Object, objOrdner As Object
  
   On Error Resume Next
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objFolder = objFSO.getfolder(strPath)
   For Each objOrdner In objFolder.subfolders
      ReDim Preserve strOrdner(0 To lngCounter)
      strOrdner(lngCounter) = objOrdner.Path
      lngCounter = lngCounter + 1
   Next objOrdner
  
   Set objFolder = Nothing
   Set objFSO = Nothing
End Function

Private Sub cbDokument_Click()
   Dim strText As String
   Dim varText As Variant
  
   strText = strOrdner(cbDokument.ListIndex)
   Erase strOrdner
   fncOrdner strText, strOrdner()
   For lngCounter = 0 To UBound(strOrdner)
      varText = Split(strOrdner(lngCounter), "\")
      If UBound(varText) > -1 Then cbDokument2.AddItem varText(UBound(varText))
   Next lngCounter
End Sub