In UserForm den Explorer starten

19/02/2010 - 17:11 von Peter Fischer | Report spam
Hallo zusammen,
ich möchte gerne aus einer UserForm heraus, den Explorer starten, eine
beliebige Excel-Datei suchen können und auswàhlen und öffnen, also für
die UserForm verfügbar machen. Kann mir jemand schreiben, wie ich das
anstellen kann?

Gruß
Peter
 

Lesen sie die antworten

#1 Andreas Killer
19/02/2010 - 18:53 | Warnen spam
Peter Fischer schrieb:

ich möchte gerne aus einer UserForm heraus, den Explorer starten, eine
beliebige Excel-Datei suchen können und auswàhlen und öffnen, also für
die UserForm verfügbar machen. Kann mir jemand schreiben, wie ich das
anstellen kann?


Den Explorer könntest Du zwar starten aber nicht kontrollieren. Jedoch
kann Du das "Öffnen"-Fenster zum Öffnen Deiner Exceldatei nehmen.

Andreas.

Private Sub CommandButton1_Click()
Dim FName As String
If Not GetOpenFileName(FName, , "*.xls", "Excel-Dateien") _
Then Exit Sub
Workbooks.Open FName
End Sub

Function GetOpenFileName(ByRef FileToOpen As String, _
Optional ByVal Pfad As String = "", Optional ByVal Maske _
As String = "", Optional ByVal FileTyp As String = "", _
Optional ByVal Titel As String = "") As Boolean
'Zeigt das Dialogfeld "Öffnen", Liefert True wenn eine Datei _
ausgewàhlt wurde und den Namen in FileToOpen
'mehrere FileTypen, bzw. Masken können durch | getrennt _
angeben werden
'Beispiel: Maske:= "*.zip;*.arj|*.txt", FileTyp:= _
"Archive|Textdateien"
GetOpenFileName = GetOpenFileNamePrim(FileToOpen, False, _
Pfad, Maske, FileTyp, Titel) > 0
End Function

Private Function GetOpenFileNamePrim( _
ByRef FileArray As Variant, ByVal Multi As Boolean, _
Optional ByVal Pfad As String = "", Optional ByVal Maske _
As String = "", Optional ByVal FileTyp As String = "", _
Optional ByVal Titel As String) As Long
'Zeigt das Dialogfeld "Öffnen" und liefert den ausgewàhlten _
Dateinamen
'Mehrere FileTypen, bzw. Masken können durch | getrennt _
angeben werden
'Beispiel: Maske:= "*.zip;*.arj|*.txt", FileTyp:= _
"Archive|Textdateien"
Dim SavePfad As String, FileFilter As String, FileToOpen As _
Variant, DoRedim As Boolean
Dim FData() As String, SData() As String, I As Long, J As Long

'Aktuellen Pfad sichern
SavePfad = CurDir
'Ggf. auf Laufwerk, Pfad wechseln
If Len(Pfad) > 0 Then
On Error GoTo ExitPoint
If InStr(Pfad, ":") > 0 Then ChDrive Pfad
ChDir Pfad
On Error GoTo 0
End If

'Mehrfache Angaben aufsplitten
FData = Split(FileTyp & "|", "|")
SData = Split(Maske & "|", "|")
'Sicherstellen das die Datenfelder gleich groß sind
If UBound(FData) > UBound(SData) Then ReDim Preserve SData( _
LBound(SData) To UBound(FData)) As String
If UBound(SData) > UBound(FData) Then ReDim Preserve FData( _
LBound(FData) To UBound(SData)) As String

'Den Filefilter zusammensetzen
FileFilter = ""
For I = LBound(FData) To UBound(FData)
If Len(FData(I) & SData(I)) > 0 Then
FileFilter = FileFilter & FData(I)
If Len(FData(I)) > 0 Then FileFilter = FileFilter & " "
FileFilter = FileFilter & "(" & SData(I) & ")," & SData( _
I) & ","
End If
Next
If Len(FileFilter) > 0 Then FileFilter = Mid(FileFilter, 1, _
Len(FileFilter) - 1)

'Datei(en) auswàhlen
FileToOpen = Application.GetOpenFileName(FileFilter, Title:= _
Titel, MultiSelect:=Multi)

'Was wurde selektiert?
GetOpenFileNamePrim = 0
Select Case VarType(FileToOpen)
Case vbBoolean
'Keine Datei, Abbruch
GoTo ExitPoint
Case vbString
'Einzelne Datei
FileArray = FileToOpen
GetOpenFileNamePrim = 1
Case Else
'Mehrere Dateien
On Error Resume Next
'Hat das array genug Platz?
DoRedim = UBound(FileToOpen) - LBound(FileToOpen) > _
UBound(FileArray) - LBound(FileArray)
If Err <> 0 Then
'Nein, array ist nicht dimensioniert
DoRedim = True
Err.Clear
End If
If DoRedim Then
ReDim FileArray(0 To UBound(FileToOpen) - LBound( _
FileToOpen)) As String
If Err <> 0 Then
'Array ist vordimensioniert und zu klein
GoTo ExitPoint
End If
End If
On Error GoTo 0
'Dateinamen übertragen
J = LBound(FileArray)
For I = LBound(FileToOpen) To UBound(FileToOpen)
FileArray(J) = FileToOpen(I)
J = J + 1
Next
GetOpenFileNamePrim = UBound(FileToOpen) - LBound( _
FileToOpen) + 1
'Ggf. restliche Plàtze löschen
For I = J To UBound(FileArray)
FileArray(I) = ""
Next
End Select

ExitPoint:
On Error GoTo 0
ChDrive SavePfad
ChDir SavePfad
End Function

Ähnliche fragen