Registriert seit: 11.04.2014
Version(en): '97 bis 2016; 365
Hallo Michael, Zitat: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?
Registriert seit: 11.04.2014
Version(en): '97 bis 2016; 365
Hallo,
ok, ich habe da wohl was durcheinandergewürfelt. Nichts für Ungut. Sorry
Registriert seit: 11.04.2014
Version(en): Office 2007
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.
Gruß Stefan Win 10 / Office 2016
Registriert seit: 14.04.2014
Version(en): 2007
Hallo!
Schade! Aber vielleicht hat ein anderer noch eine Idee!
Registriert seit: 11.04.2014
Version(en): Office 2007
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
Gruß Stefan Win 10 / Office 2016
Registriert seit: 14.04.2014
Version(en): 2007
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.)
Registriert seit: 11.04.2014
Version(en): Office 2007
16.06.2016, 14:48
(Dieser Beitrag wurde zuletzt bearbeitet: 16.06.2016, 14:48 von Steffl.
Bearbeitungsgrund: Codeänderung an der Funktion
)
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
Gruß Stefan Win 10 / Office 2016
Registriert seit: 14.04.2014
Version(en): 2007
Hallo Stefan!
Tausend Dank für die Hilfe ! Muss heute Abend noch genauer Testen
:100:
Registriert seit: 14.04.2014
Version(en): 2007
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?
Registriert seit: 11.04.2014
Version(en): Office 2007
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
Gruß Stefan Win 10 / Office 2016
|