wie kann ich in die Dropdownliste einer selbsterstellte Symbolleiste
die "xls" Dateien eines Unterverzeichnis einlesen und bei einen Klick
auf die Auswahl die Datei öffnen?
Danke Peter
Private Sub Workbook_Open()
Dim objCmdBar As CommandBar
Dim objCbo As CommandBarComboBox
Dim intCounter As Integer
Dim VzPfad
Dim DatTyp
Dim Datname
On Error Resume Next
Application.CommandBars("Dateien").Delete
On Error GoTo 0
Set objCmdBar = Application.CommandBars.Add("Dateien", msoBarTop)
Set objCbo = objCmdBar.Controls.Add(msoControlComboBox)
'Deklaration für Dateiauflistung
VzPfad = "A:\Abt\Urlaubslisten"
If VzPfad = "" Then Exit Sub
DatTyp = "xls"
If DatTyp = "" Then Exit Sub
ChDrive Left(VzPfad, 1)
ChDir VzPfad
Datname = Dir("*." & DatTyp)
With objCbo
Do Until Datname = Mid(Format(Year(Date), "JJJJ"), 7, 4)
.AddItem Datname
Loop
.OnAction = "DateienLaden"
.ListIndex = 0
End With
objCmdBar.Visible = True
End Sub
Sub Datei_Menue()
Dim objCmdBar As CommandBar
Dim objCbo As CommandBarComboBox
Dim VzPfad As String
Dim Verz As Folder
Dim Datei As File
On Error Resume Next
Application.CommandBars("Dateien").Delete
VzPfad = InputBox("Verzeichnis", "Verzeichnis", "A:\Abt\Urlaubslisten")
If VzPfad = "" Then Exit Sub
Err.Clear
Set Verz = fso.GetFolder(VzPfad)
If Err.Number <> 0 Then
MsgBox "Auf das Verzeichniss:" & vbNewLine & VzPfad & vbNewLine & _
"kann nicht zugegriffen werden."
Exit Sub
End If
On Error GoTo 0
Set objCmdBar = Application.CommandBars.Add("Dateien", msoBarTop)
Set objCbo = objCmdBar.Controls.Add(msoControlComboBox)
For Each Datei In Verz.Files
If UCase(Right(Datei.Name, 3)) = "XLS" Then objCbo.AddItem Datei.Name
Next
If Right(Verz.Path, 1) = "\" Then
objCbo.Parameter = Verz.Path
Else
objCbo.Parameter = Verz.Path & "\"
End If
objCbo.OnAction = "DateiOeffnen"
objCmdBar.Visible = True
End Sub
Sub DateiOeffnen()
Dim objCbo As CommandBarComboBox
Set objCbo = Application.CommandBars("Dateien").Controls(1)
Application.Workbooks.Open objCbo.Parameter & objCbo.Text
End Sub