Hallo Experten!
Ersteinmal an alle ein Danke!
Habe aber ein neue Herausforderung an euch!
in der Userform Start sind 3 Listboxen, dei erste heißt LBOrdner, die zweite ListBox2 und dei dritte ListBox3.
In der LBordner werden Dateien von einem Laufwerk eingelesen
In der ListBox2 werden die Unterordner der Dateien dann eingelsen
In der ListBox3 werden die *.xls Dateien eingelesen
So nun zu der Herausforderung!
mit diesen Code lesen wir die Ordner in LBOrdner ein
Code:
Private Sub UserForm_Initialize()
Dim varText As Variant
strOrdnerEbene1() = fncOrdner("D:\Wartungspläne\")
For lngCounter = 0 To UBound(strOrdnerEbene1)
varText = Split(strOrdnerEbene1(lngCounter), "\")
cbDokument.AddItem varText(UBound(varText))
LBOrdner.AddItem varText(UBound(varText))
Next lngCounter
lngCounter = 0
With Me.cbQar
.AddItem "Kontrollkarte 1. Quartal"
.AddItem "Kontrollkarte 2. Quartal"
.AddItem "Kontrollkarte 3. Quartal"
.AddItem "Kontrollkarte 4. Quartal"
.ListIndex = -1 'Vorbelegung "" bei Formularstart
End With
Cbjahr.List = [row(2014:2030)]
Me.CommandButton3.BackColor = vbGreen
Me.CommandButton3.Caption = "Alle Ordner auswählen"
Zähler1 = 0
Me.CommandButton4.BackColor = vbGreen
Me.CommandButton4.Caption = "Alle Unterordner auswählen"
Zähler2 = 0
Me.CommandButton5.BackColor = vbGreen
Me.CommandButton5.Caption = "Alle Dateien auswählen"
Zähler3 = 0
'ListBox1.MultiSelect = fmMultiSelectMulti
'ListBox1.ListStyle = fmListStyleOption
'ListBox2.MultiSelect = fmMultiSelectMulti
'ListBox2.ListStyle = fmListStyleOption
End Sub
Function fncOrdner(strPath As String) As String()
Dim objFSO As Object, objFolder As Object, objOrdner As Object
Dim strOrdner() As String
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
fncOrdner = strOrdner
Set objFolder = Nothing
Set objFSO = Nothing
End Function
Sub prcDateien(strPath As String)
Dim objFSO As Object, objFolder As Object, objDatei As Object
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.getfolder(strPath)
For Each objDatei In objFolder.Files
If InStr(objDatei.name, ".xls") Then ListBox2.AddItem objDatei.name
Next objDatei
Set objFolder = Nothing
Set objFSO = Nothing
End Sub
Mach ich jetzt eine auswahl in LBOrdner werden mir sofort alle Unterordner in Listbox2 angezeigt.
DblClick in ListBox2 mit Multiseleckt alle angewählten *.xls Dateien werden in ListBox3 angezeigt.
Soweit alles i.O.
Ich möchte jezt aber gerne eine merfachauswahl in der LBOrdner über einenCommandButton treffen oder über DblClick.
Die Auswahl über CommandButton geht, alle werden selektiert.
Multiselct geht auch. Einstellungen in der Eigenschaft wurden auch angepasst.
Jetzt kommen wir zu der Herausforderung!
1. Bei auswahl mit Multiselect LBOrndner werden keine *.xls Dateien mehr in der ListBox3 angezeigt
2. Wenn Multiselect angewählt ist, werden immer nur die UnterOrdner von LBOrdner angezeigt den ich zuletzt angewählt habe, nicht alle die angewählt wurden
Was mach ich FALSCH?
Um zu wissen worum es geht, ich muss ca. 100 Blätter ausdrucken. In den TabellenBlättern wird immer das Jahr geändert. Der Code steht!
Ich möchte damit erreichen wenn ich den Button Drucken wähle das Alle Dateien ausgedruckt werden die in der Listbox dann stehen
Was ich noch gerne möchte, ist die MehrfachAuswahl mit einen einfachen Click erzeugen!
Wenn noch FRAGEN sind unbedingt MELDEN!
